home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / gnus / gnus-group.el.z / gnus-group.el
Encoding:
Text File  |  1998-05-21  |  117.2 KB  |  3,356 lines

  1. ;;; gnus-group.el --- group mode commands for Gnus
  2. ;; Copyright (C) 1996,97 Free Software Foundation, Inc.
  3.  
  4. ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
  5. ;; Keywords: news
  6.  
  7. ;; This file is part of GNU Emacs.
  8.  
  9. ;; GNU Emacs is free software; you can redistribute it and/or modify
  10. ;; it under the terms of the GNU General Public License as published by
  11. ;; the Free Software Foundation; either version 2, or (at your option)
  12. ;; any later version.
  13.  
  14. ;; GNU Emacs is distributed in the hope that it will be useful,
  15. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.     See the
  17. ;; GNU General Public License for more details.
  18.  
  19. ;; You should have received a copy of the GNU General Public License
  20. ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  21. ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  22. ;; Boston, MA 02111-1307, USA.
  23.  
  24. ;;; Commentary:
  25.  
  26. ;;; Code:
  27.  
  28. (eval-when-compile (require 'cl))
  29.  
  30. (require 'gnus)
  31. (require 'gnus-start)
  32. (require 'nnmail)
  33. (require 'gnus-spec)
  34. (require 'gnus-int)
  35. (require 'gnus-range)
  36. (require 'gnus-win)
  37. (require 'gnus-undo)
  38.  
  39. (defcustom gnus-group-archive-directory
  40.   "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list/"
  41.   "*The address of the (ding) archives."
  42.   :group 'gnus-group-foreign
  43.   :type 'directory)
  44.  
  45. (defcustom gnus-group-recent-archive-directory
  46.   "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list-recent/"
  47.   "*The address of the most recent (ding) articles."
  48.   :group 'gnus-group-foreign
  49.   :type 'directory)
  50.  
  51. (defcustom gnus-no-groups-message "No news is no news"
  52.   "*Message displayed by Gnus when no groups are available."
  53.   :group 'gnus-start
  54.   :type 'string)
  55.  
  56. (defcustom gnus-keep-same-level nil
  57.   "*Non-nil means that the next newsgroup after the current will be on the same level.
  58. When you type, for instance, `n' after reading the last article in the
  59. current newsgroup, you will go to the next newsgroup.  If this variable
  60. is nil, the next newsgroup will be the next from the group
  61. buffer.
  62. If this variable is non-nil, Gnus will either put you in the
  63. next newsgroup with the same level, or, if no such newsgroup is
  64. available, the next newsgroup with the lowest possible level higher
  65. than the current level.
  66. If this variable is `best', Gnus will make the next newsgroup the one
  67. with the best level."
  68.   :group 'gnus-group-levels
  69.   :type '(choice (const nil)
  70.          (const best)
  71.          (sexp :tag "other" t)))
  72.  
  73. (defcustom gnus-group-goto-unread t
  74.   "*If non-nil, movement commands will go to the next unread and subscribed group."
  75.   :link '(custom-manual "(gnus)Group Maneuvering")
  76.   :group 'gnus-group-various
  77.   :type 'boolean)
  78.  
  79. (defcustom gnus-goto-next-group-when-activating t
  80.   "*If non-nil, the \\<gnus-group-mode-map>\\[gnus-group-get-new-news-this-group] command will advance point to the next group."
  81.   :link '(custom-manual "(gnus)Scanning New Messages")
  82.   :group 'gnus-group-various
  83.   :type 'boolean)
  84.  
  85. (defcustom gnus-permanently-visible-groups nil
  86.   "*Regexp to match groups that should always be listed in the group buffer.
  87. This means that they will still be listed even when there are no
  88. unread articles in the groups.
  89.  
  90. If nil, no groups are permanently visible."
  91.   :group 'gnus-group-listing
  92.   :type '(choice regexp (const nil)))
  93.  
  94. (defcustom gnus-list-groups-with-ticked-articles t
  95.   "*If non-nil, list groups that have only ticked articles.
  96. If nil, only list groups that have unread articles."
  97.   :group 'gnus-group-listing
  98.   :type 'boolean)
  99.  
  100. (defcustom gnus-group-default-list-level gnus-level-subscribed
  101.   "*Default listing level.
  102. Ignored if `gnus-group-use-permanent-levels' is non-nil."
  103.   :group 'gnus-group-listing
  104.   :type 'integer)
  105.  
  106. (defcustom gnus-group-list-inactive-groups t
  107.   "*If non-nil, inactive groups will be listed."
  108.   :group 'gnus-group-listing
  109.   :group 'gnus-group-levels
  110.   :type 'boolean)
  111.  
  112. (defcustom gnus-group-sort-function 'gnus-group-sort-by-alphabet
  113.   "*Function used for sorting the group buffer.
  114. This function will be called with group info entries as the arguments
  115. for the groups to be sorted.  Pre-made functions include
  116. `gnus-group-sort-by-alphabet', `gnus-group-sort-by-real-name',
  117. `gnus-group-sort-by-unread', `gnus-group-sort-by-level',
  118. `gnus-group-sort-by-score', `gnus-group-sort-by-method', and
  119. `gnus-group-sort-by-rank'.
  120.  
  121. This variable can also be a list of sorting functions.    In that case,
  122. the most significant sort function should be the last function in the
  123. list."
  124.   :group 'gnus-group-listing
  125.   :link '(custom-manual "(gnus)Sorting Groups")
  126.   :type '(radio (function-item gnus-group-sort-by-alphabet)
  127.         (function-item gnus-group-sort-by-real-name)
  128.         (function-item gnus-group-sort-by-unread)
  129.         (function-item gnus-group-sort-by-level)
  130.         (function-item gnus-group-sort-by-score)
  131.         (function-item gnus-group-sort-by-method)
  132.         (function-item gnus-group-sort-by-rank)
  133.         (function :tag "other" nil)))
  134.  
  135. (defcustom gnus-group-line-format "%M\%S\%p\%P\%5y: %(%g%)%l\n"
  136.   "*Format of group lines.
  137. It works along the same lines as a normal formatting string,
  138. with some simple extensions.
  139.  
  140. %M    Only marked articles (character, \"*\" or \" \")
  141. %S    Whether the group is subscribed (character, \"U\", \"K\", \"Z\" or \" \")
  142. %L    Level of subscribedness (integer)
  143. %N    Number of unread articles (integer)
  144. %I    Number of dormant articles (integer)
  145. %i    Number of ticked and dormant (integer)
  146. %T    Number of ticked articles (integer)
  147. %R    Number of read articles (integer)
  148. %t    Estimated total number of articles (integer)
  149. %y    Number of unread, unticked articles (integer)
  150. %G    Group name (string)
  151. %g    Qualified group name (string)
  152. %D    Group description (string)
  153. %s    Select method (string)
  154. %o    Moderated group (char, \"m\")
  155. %p    Process mark (char)
  156. %O    Moderated group (string, \"(m)\" or \"\")
  157. %P    Topic indentation (string)
  158. %m    Whether there is new(ish) mail in the group (char, \"%\")
  159. %l    Whether there are GroupLens predictions for this group (string)
  160. %n    Select from where (string)
  161. %z    A string that look like `<%s:%n>' if a foreign select method is used
  162. %d    The date the group was last entered.
  163. %u    User defined specifier.  The next character in the format string should
  164.       be a letter.  Gnus will call the function gnus-user-format-function-X,
  165.       where X is the letter following %u.  The function will be passed the
  166.       current header as argument.  The function should return a string, which
  167.       will be inserted into the buffer just like information from any other
  168.       group specifier.
  169.  
  170. Text between %( and %) will be highlighted with `gnus-mouse-face' when
  171. the mouse point move inside the area.  There can only be one such area.
  172.  
  173. Note that this format specification is not always respected.  For
  174. reasons of efficiency, when listing killed groups, this specification
  175. is ignored altogether.    If the spec is changed considerably, your
  176. output may end up looking strange when listing both alive and killed
  177. groups.
  178.  
  179. If you use %o or %O, reading the active file will be slower and quite
  180. a bit of extra memory will be used.  %D will also worsen performance.
  181. Also note that if you change the format specification to include any
  182. of these specs, you must probably re-start Gnus to see them go into
  183. effect."
  184.   :group 'gnus-group-visual
  185.   :type 'string)
  186.  
  187. (defcustom gnus-group-mode-line-format "Gnus: %%b {%M\%:%S}"
  188.   "*The format specification for the group mode line.
  189. It works along the same lines as a normal formatting string,
  190. with some simple extensions:
  191.  
  192. %S   The native news server.
  193. %M   The native select method.
  194. %:   \":\" if %S isn't \"\"."
  195.   :group 'gnus-group-visual
  196.   :type 'string)
  197.  
  198. (defcustom gnus-group-mode-hook nil
  199.   "Hook for Gnus group mode."
  200.   :group 'gnus-group-various
  201.   :options '(gnus-topic-mode)
  202.   :type 'hook)
  203.  
  204. (defcustom gnus-group-menu-hook nil
  205.   "Hook run after the creation of the group mode menu."
  206.   :group 'gnus-group-various
  207.   :type 'hook)
  208.  
  209. (defcustom gnus-group-catchup-group-hook nil
  210.   "Hook run when catching up a group from the group buffer."
  211.   :group 'gnus-group-various
  212.   :link '(custom-manual "(gnus)Group Data")
  213.   :type 'hook)
  214.  
  215. (defcustom gnus-group-update-group-hook nil
  216.   "Hook called when updating group lines."
  217.   :group 'gnus-group-visual
  218.   :type 'hook)
  219.  
  220. (defcustom gnus-group-prepare-function 'gnus-group-prepare-flat
  221.   "*A function that is called to generate the group buffer.
  222. The function is called with three arguments: The first is a number;
  223. all group with a level less or equal to that number should be listed,
  224. if the second is non-nil, empty groups should also be displayed.  If
  225. the third is non-nil, it is a number.  No groups with a level lower
  226. than this number should be displayed.
  227.  
  228. The only current function implemented is `gnus-group-prepare-flat'."
  229.   :group 'gnus-group-listing
  230.   :type 'function)
  231.  
  232. (defcustom gnus-group-prepare-hook nil
  233.   "Hook called after the group buffer has been generated.
  234. If you want to modify the group buffer, you can use this hook."
  235.   :group 'gnus-group-listing
  236.   :type 'hook)
  237.  
  238. (defcustom gnus-suspend-gnus-hook nil
  239.   "Hook called when suspending (not exiting) Gnus."
  240.   :group 'gnus-exit
  241.   :type 'hook)
  242.  
  243. (defcustom gnus-exit-gnus-hook nil
  244.   "Hook called when exiting Gnus."
  245.   :group 'gnus-exit
  246.   :type 'hook)
  247.  
  248. (defcustom gnus-after-exiting-gnus-hook nil
  249.   "Hook called after exiting Gnus."
  250.   :group 'gnus-exit
  251.   :type 'hook)
  252.  
  253. (defcustom gnus-group-update-hook '(gnus-group-highlight-line)
  254.   "Hook called when a group line is changed.
  255. The hook will not be called if `gnus-visual' is nil.
  256.  
  257. The default function `gnus-group-highlight-line' will
  258. highlight the line according to the `gnus-group-highlight'
  259. variable."
  260.   :group 'gnus-group-visual
  261.   :type 'hook)
  262.  
  263. (defcustom gnus-useful-groups
  264.   `(("(ding) mailing list mirrored at sunsite.auc.dk"
  265.      "emacs.ding"
  266.      (nntp "sunsite.auc.dk"
  267.             (nntp-address "sunsite.auc.dk")))
  268.     ("Gnus help group"
  269.      "gnus-help"
  270.      (nndoc "gnus-help"
  271.         (nndoc-article-type mbox)
  272.         (eval `(nndoc-address
  273.             ,(let ((file (nnheader-find-etc-directory
  274.                   "gnus-tut.txt" t)))
  275.                (unless file
  276.              (error "Couldn't find doc group"))
  277.                file))))))
  278.   "Alist of useful group-server pairs."
  279.   :group 'gnus-group-listing
  280.   :type '(repeat (list (string :tag "Description")
  281.                (string :tag "Name")
  282.                (sexp :tag "Method"))))
  283.  
  284. (defcustom gnus-group-highlight
  285.   '(;; News.
  286.     ((and (= unread 0) (not mailp) (eq level 1)) .
  287.      gnus-group-news-1-empty-face)
  288.     ((and (not mailp) (eq level 1)) .
  289.      gnus-group-news-1-face)
  290.     ((and (= unread 0) (not mailp) (eq level 2)) .
  291.      gnus-group-news-2-empty-face)
  292.     ((and (not mailp) (eq level 2)) .
  293.      gnus-group-news-2-face)
  294.     ((and (= unread 0) (not mailp) (eq level 3)) .
  295.      gnus-group-news-3-empty-face)
  296.     ((and (not mailp) (eq level 3)) .
  297.      gnus-group-news-3-face)
  298.     ((and (= unread 0) (not mailp)) .
  299.      gnus-group-news-low-empty-face)
  300.     ((and (not mailp)) .
  301.      gnus-group-news-low-face)
  302.     ;; Mail.
  303.     ((and (= unread 0) (eq level 1)) .
  304.      gnus-group-mail-1-empty-face)
  305.     ((eq level 1) .
  306.      gnus-group-mail-1-face)
  307.     ((and (= unread 0) (eq level 2)) .
  308.      gnus-group-mail-2-empty-face)
  309.     ((eq level 2) .
  310.      gnus-group-mail-2-face)
  311.     ((and (= unread 0) (eq level 3)) .
  312.      gnus-group-mail-3-empty-face)
  313.     ((eq level 3) .
  314.      gnus-group-mail-3-face)
  315.     ((= unread 0) .
  316.      gnus-group-mail-low-empty-face)
  317.     (t .
  318.      gnus-group-mail-low-face))
  319.   "Controls the highlighting of group buffer lines.
  320.  
  321. Below is a list of `Form'/`Face' pairs.  When deciding how a a
  322. particular group line should be displayed, each form is
  323. evaluated.  The content of the face field after the first true form is
  324. used.  You can change how those group lines are displayed by
  325. editing the face field.
  326.  
  327. It is also possible to change and add form fields, but currently that
  328. requires an understanding of Lisp expressions.  Hopefully this will
  329. change in a future release.  For now, you can use the following
  330. variables in the Lisp expression:
  331.  
  332. group: The name of the group.
  333. unread: The number of unread articles in the group.
  334. method: The select method used.
  335. mailp: Whether it's a mail group or not.
  336. level: The level of the group.
  337. score: The score of the group.
  338. ticked: The number of ticked articles."
  339.   :group 'gnus-group-visual
  340.   :type '(repeat (cons (sexp :tag "Form") face)))
  341.  
  342. (defcustom gnus-new-mail-mark ?%
  343.   "Mark used for groups with new mail."
  344.   :group 'gnus-group-visual
  345.   :type 'character)
  346.  
  347. ;;; Internal variables
  348.  
  349. (defvar gnus-group-sort-alist-function 'gnus-group-sort-flat
  350.   "Function for sorting the group buffer.")
  351.  
  352. (defvar gnus-group-sort-selected-function 'gnus-group-sort-selected-flat
  353.   "Function for sorting the selected groups in the group buffer.")
  354.  
  355. (defvar gnus-group-indentation-function nil)
  356. (defvar gnus-goto-missing-group-function nil)
  357. (defvar gnus-group-update-group-function nil)
  358. (defvar gnus-group-goto-next-group-function nil
  359.   "Function to override finding the next group after listing groups.")
  360.  
  361. (defvar gnus-group-edit-buffer nil)
  362.  
  363. (defvar gnus-group-line-format-alist
  364.   `((?M gnus-tmp-marked-mark ?c)
  365.     (?S gnus-tmp-subscribed ?c)
  366.     (?L gnus-tmp-level ?d)
  367.     (?N (cond ((eq number t) "*" )
  368.           ((numberp number)
  369.            (int-to-string
  370.         (+ number
  371.            (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked)))
  372.            (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))))))
  373.           (t number)) ?s)
  374.     (?R gnus-tmp-number-of-read ?s)
  375.     (?t gnus-tmp-number-total ?d)
  376.     (?y gnus-tmp-number-of-unread ?s)
  377.     (?I (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) ?d)
  378.     (?T (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))) ?d)
  379.     (?i (+ (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked)))
  380.        (gnus-range-length (cdr (assq 'tick gnus-tmp-marked)))) ?d)
  381.     (?g gnus-tmp-group ?s)
  382.     (?G gnus-tmp-qualified-group ?s)
  383.     (?c (gnus-short-group-name gnus-tmp-group) ?s)
  384.     (?D gnus-tmp-newsgroup-description ?s)
  385.     (?o gnus-tmp-moderated ?c)
  386.     (?O gnus-tmp-moderated-string ?s)
  387.     (?p gnus-tmp-process-marked ?c)
  388.     (?s gnus-tmp-news-server ?s)
  389.     (?n gnus-tmp-news-method ?s)
  390.     (?P gnus-group-indentation ?s)
  391.     (?l gnus-tmp-grouplens ?s)
  392.     (?z gnus-tmp-news-method-string ?s)
  393.     (?m (gnus-group-new-mail gnus-tmp-group) ?c)
  394.     (?d (gnus-group-timestamp-string gnus-tmp-group) ?s)
  395.     (?u gnus-tmp-user-defined ?s)))
  396.  
  397. (defvar gnus-group-mode-line-format-alist
  398.   `((?S gnus-tmp-news-server ?s)
  399.     (?M gnus-tmp-news-method ?s)
  400.     (?u gnus-tmp-user-defined ?s)
  401.     (?: gnus-tmp-colon ?s)))
  402.  
  403. (defvar gnus-topic-topology nil
  404.   "The complete topic hierarchy.")
  405.  
  406. (defvar gnus-topic-alist nil
  407.   "The complete topic-group alist.")
  408.  
  409. (defvar gnus-group-marked nil)
  410.  
  411. (defvar gnus-group-list-mode nil)
  412.  
  413. ;;;
  414. ;;; Gnus group mode
  415. ;;;
  416.  
  417. (put 'gnus-group-mode 'mode-class 'special)
  418.  
  419. (when t
  420.   (gnus-define-keys gnus-group-mode-map
  421.     " " gnus-group-read-group
  422.     "=" gnus-group-select-group
  423.     "\r" gnus-group-select-group
  424.     "\M-\r" gnus-group-quick-select-group
  425.     [(meta control return)] gnus-group-select-group-ephemerally
  426.     "j" gnus-group-jump-to-group
  427.     "n" gnus-group-next-unread-group
  428.     "p" gnus-group-prev-unread-group
  429.     "\177" gnus-group-prev-unread-group
  430.     [delete] gnus-group-prev-unread-group
  431.     [backspace] gnus-group-prev-unread-group
  432.     "N" gnus-group-next-group
  433.     "P" gnus-group-prev-group
  434.     "\M-n" gnus-group-next-unread-group-same-level
  435.     "\M-p" gnus-group-prev-unread-group-same-level
  436.     "," gnus-group-best-unread-group
  437.     "." gnus-group-first-unread-group
  438.     "u" gnus-group-unsubscribe-current-group
  439.     "U" gnus-group-unsubscribe-group
  440.     "c" gnus-group-catchup-current
  441.     "C" gnus-group-catchup-current-all
  442.     "\M-c" gnus-group-clear-data
  443.     "l" gnus-group-list-groups
  444.     "L" gnus-group-list-all-groups
  445.     "m" gnus-group-mail
  446.     "g" gnus-group-get-new-news
  447.     "\M-g" gnus-group-get-new-news-this-group
  448.     "R" gnus-group-restart
  449.     "r" gnus-group-read-init-file
  450.     "B" gnus-group-browse-foreign-server
  451.     "b" gnus-group-check-bogus-groups
  452.     "F" gnus-group-find-new-groups
  453.     "\C-c\C-d" gnus-group-describe-group
  454.     "\M-d" gnus-group-describe-all-groups
  455.     "\C-c\C-a" gnus-group-apropos
  456.     "\C-c\M-\C-a" gnus-group-description-apropos
  457.     "a" gnus-group-post-news
  458.     "\ek" gnus-group-edit-local-kill
  459.     "\eK" gnus-group-edit-global-kill
  460.     "\C-k" gnus-group-kill-group
  461.     "\C-y" gnus-group-yank-group
  462.     "\C-w" gnus-group-kill-region
  463.     "\C-x\C-t" gnus-group-transpose-groups
  464.     "\C-c\C-l" gnus-group-list-killed
  465.     "\C-c\C-x" gnus-group-expire-articles
  466.     "\C-c\M-\C-x" gnus-group-expire-all-groups
  467.     "V" gnus-version
  468.     "s" gnus-group-save-newsrc
  469.     "z" gnus-group-suspend
  470.     "q" gnus-group-exit
  471.     "Q" gnus-group-quit
  472.     "?" gnus-group-describe-briefly
  473.     "\C-c\C-i" gnus-info-find-node
  474.     "\M-e" gnus-group-edit-group-method
  475.     "^" gnus-group-enter-server-mode
  476.     gnus-mouse-2 gnus-mouse-pick-group
  477.     "<" beginning-of-buffer
  478.     ">" end-of-buffer
  479.     "\C-c\C-b" gnus-bug
  480.     "\C-c\C-s" gnus-group-sort-groups
  481.     "t" gnus-topic-mode
  482.     "\C-c\M-g" gnus-activate-all-groups
  483.     "\M-&" gnus-group-universal-argument
  484.     "#" gnus-group-mark-group
  485.     "\M-#" gnus-group-unmark-group)
  486.  
  487.   (gnus-define-keys (gnus-group-mark-map "M" gnus-group-mode-map)
  488.     "m" gnus-group-mark-group
  489.     "u" gnus-group-unmark-group
  490.     "w" gnus-group-mark-region
  491.     "b" gnus-group-mark-buffer
  492.     "r" gnus-group-mark-regexp
  493.     "U" gnus-group-unmark-all-groups)
  494.  
  495.   (gnus-define-keys (gnus-group-group-map "G" gnus-group-mode-map)
  496.     "d" gnus-group-make-directory-group
  497.     "h" gnus-group-make-help-group
  498.     "u" gnus-group-make-useful-group
  499.     "a" gnus-group-make-archive-group
  500.     "k" gnus-group-make-kiboze-group
  501.     "m" gnus-group-make-group
  502.     "E" gnus-group-edit-group
  503.     "e" gnus-group-edit-group-method
  504.     "p" gnus-group-edit-group-parameters
  505.     "v" gnus-group-add-to-virtual
  506.     "V" gnus-group-make-empty-virtual
  507.     "D" gnus-group-enter-directory
  508.     "f" gnus-group-make-doc-group
  509.     "w" gnus-group-make-web-group
  510.     "r" gnus-group-rename-group
  511.     "c" gnus-group-customize
  512.     "\177" gnus-group-delete-group
  513.     [delete] gnus-group-delete-group)
  514.  
  515.   (gnus-define-keys (gnus-group-soup-map "s" gnus-group-group-map)
  516.     "b" gnus-group-brew-soup
  517.     "w" gnus-soup-save-areas
  518.     "s" gnus-soup-send-replies
  519.     "p" gnus-soup-pack-packet
  520.     "r" nnsoup-pack-replies)
  521.  
  522.   (gnus-define-keys (gnus-group-sort-map "S" gnus-group-group-map)
  523.     "s" gnus-group-sort-groups
  524.     "a" gnus-group-sort-groups-by-alphabet
  525.     "u" gnus-group-sort-groups-by-unread
  526.     "l" gnus-group-sort-groups-by-level
  527.     "v" gnus-group-sort-groups-by-score
  528.     "r" gnus-group-sort-groups-by-rank
  529.     "m" gnus-group-sort-groups-by-method)
  530.  
  531.   (gnus-define-keys (gnus-group-sort-selected-map "P" gnus-group-group-map)
  532.     "s" gnus-group-sort-selected-groups
  533.     "a" gnus-group-sort-selected-groups-by-alphabet
  534.     "u" gnus-group-sort-selected-groups-by-unread
  535.     "l" gnus-group-sort-selected-groups-by-level
  536.     "v" gnus-group-sort-selected-groups-by-score
  537.     "r" gnus-group-sort-selected-groups-by-rank
  538.     "m" gnus-group-sort-selected-groups-by-method)
  539.  
  540.   (gnus-define-keys (gnus-group-list-map "A" gnus-group-mode-map)
  541.     "k" gnus-group-list-killed
  542.     "z" gnus-group-list-zombies
  543.     "s" gnus-group-list-groups
  544.     "u" gnus-group-list-all-groups
  545.     "A" gnus-group-list-active
  546.     "a" gnus-group-apropos
  547.     "d" gnus-group-description-apropos
  548.     "m" gnus-group-list-matching
  549.     "M" gnus-group-list-all-matching
  550.     "l" gnus-group-list-level)
  551.  
  552.   (gnus-define-keys (gnus-group-score-map "W" gnus-group-mode-map)
  553.     "f" gnus-score-flush-cache)
  554.  
  555.   (gnus-define-keys (gnus-group-help-map "H" gnus-group-mode-map)
  556.     "d" gnus-group-describe-group
  557.     "f" gnus-group-fetch-faq
  558.     "v" gnus-version)
  559.  
  560.   (gnus-define-keys (gnus-group-sub-map "S" gnus-group-mode-map)
  561.     "l" gnus-group-set-current-level
  562.     "t" gnus-group-unsubscribe-current-group
  563.     "s" gnus-group-unsubscribe-group
  564.     "k" gnus-group-kill-group
  565.     "y" gnus-group-yank-group
  566.     "w" gnus-group-kill-region
  567.     "\C-k" gnus-group-kill-level
  568.     "z" gnus-group-kill-all-zombies))
  569.  
  570. (defun gnus-group-make-menu-bar ()
  571.   (gnus-turn-off-edit-menu 'group)
  572.   (unless (boundp 'gnus-group-reading-menu)
  573.  
  574.     (easy-menu-define
  575.      gnus-group-reading-menu gnus-group-mode-map ""
  576.      '("Group"
  577.        ["Read" gnus-group-read-group (gnus-group-group-name)]
  578.        ["Select" gnus-group-select-group (gnus-group-group-name)]
  579.        ["See old articles" (gnus-group-select-group 'all)
  580.     :keys "C-u SPC" :active (gnus-group-group-name)]
  581.        ["Catch up" gnus-group-catchup-current (gnus-group-group-name)]
  582.        ["Catch up all articles" gnus-group-catchup-current-all
  583.     (gnus-group-group-name)]
  584.        ["Check for new articles" gnus-group-get-new-news-this-group
  585.     (gnus-group-group-name)]
  586.        ["Toggle subscription" gnus-group-unsubscribe-current-group
  587.     (gnus-group-group-name)]
  588.        ["Kill" gnus-group-kill-group (gnus-group-group-name)]
  589.        ["Yank" gnus-group-yank-group gnus-list-of-killed-groups]
  590.        ["Describe" gnus-group-describe-group (gnus-group-group-name)]
  591.        ["Fetch FAQ" gnus-group-fetch-faq (gnus-group-group-name)]
  592.        ;; Actually one should check, if any of the marked groups gives t for
  593.        ;; (gnus-check-backend-function 'request-expire-articles ...)
  594.        ["Expire articles" gnus-group-expire-articles
  595.     (or (and (gnus-group-group-name)
  596.          (gnus-check-backend-function
  597.           'request-expire-articles
  598.           (gnus-group-group-name))) gnus-group-marked)]
  599.        ["Set group level" gnus-group-set-current-level
  600.     (gnus-group-group-name)]
  601.        ["Select quick" gnus-group-quick-select-group (gnus-group-group-name)]
  602.        ["Customize" gnus-group-customize (gnus-group-group-name)]
  603.        ("Edit"
  604.     ["Parameters" gnus-group-edit-group-parameters
  605.      (gnus-group-group-name)]
  606.     ["Select method" gnus-group-edit-group-method
  607.      (gnus-group-group-name)]
  608.     ["Info" gnus-group-edit-group (gnus-group-group-name)]
  609.     ["Local kill file" gnus-group-edit-local-kill (gnus-group-group-name)]
  610.     ["Global kill file" gnus-group-edit-global-kill t])))
  611.  
  612.     (easy-menu-define
  613.      gnus-group-group-menu gnus-group-mode-map ""
  614.      '("Groups"
  615.        ("Listing"
  616.     ["List unread subscribed groups" gnus-group-list-groups t]
  617.     ["List (un)subscribed groups" gnus-group-list-all-groups t]
  618.     ["List killed groups" gnus-group-list-killed gnus-killed-list]
  619.     ["List zombie groups" gnus-group-list-zombies gnus-zombie-list]
  620.     ["List level..." gnus-group-list-level t]
  621.     ["Describe all groups" gnus-group-describe-all-groups t]
  622.     ["Group apropos..." gnus-group-apropos t]
  623.     ["Group and description apropos..." gnus-group-description-apropos t]
  624.     ["List groups matching..." gnus-group-list-matching t]
  625.     ["List all groups matching..." gnus-group-list-all-matching t]
  626.     ["List active file" gnus-group-list-active t])
  627.        ("Sort"
  628.     ["Default sort" gnus-group-sort-groups t]
  629.     ["Sort by method" gnus-group-sort-groups-by-method t]
  630.     ["Sort by rank" gnus-group-sort-groups-by-rank t]
  631.     ["Sort by score" gnus-group-sort-groups-by-score t]
  632.     ["Sort by level" gnus-group-sort-groups-by-level t]
  633.     ["Sort by unread" gnus-group-sort-groups-by-unread t]
  634.     ["Sort by name" gnus-group-sort-groups-by-alphabet t])
  635.        ("Sort process/prefixed"
  636.     ["Default sort" gnus-group-sort-selected-groups
  637.      (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
  638.     ["Sort by method" gnus-group-sort-selected-groups-by-method
  639.      (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
  640.     ["Sort by rank" gnus-group-sort-selected-groups-by-rank
  641.      (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
  642.     ["Sort by score" gnus-group-sort-selected-groups-by-score
  643.      (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
  644.     ["Sort by level" gnus-group-sort-selected-groups-by-level
  645.      (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
  646.     ["Sort by unread" gnus-group-sort-selected-groups-by-unread
  647.      (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
  648.     ["Sort by name" gnus-group-sort-selected-groups-by-alphabet
  649.      (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))])
  650.        ("Mark"
  651.     ["Mark group" gnus-group-mark-group
  652.      (and (gnus-group-group-name)
  653.           (not (memq (gnus-group-group-name) gnus-group-marked)))]
  654.     ["Unmark group" gnus-group-unmark-group
  655.      (and (gnus-group-group-name)
  656.           (memq (gnus-group-group-name) gnus-group-marked))]
  657.     ["Unmark all" gnus-group-unmark-all-groups gnus-group-marked]
  658.     ["Mark regexp..." gnus-group-mark-regexp t]
  659.     ["Mark region" gnus-group-mark-region t]
  660.     ["Mark buffer" gnus-group-mark-buffer t]
  661.     ["Execute command" gnus-group-universal-argument
  662.      (or gnus-group-marked (gnus-group-group-name))])
  663.        ("Subscribe"
  664.     ["Subscribe to a group" gnus-group-unsubscribe-group t]
  665.     ["Kill all newsgroups in region" gnus-group-kill-region t]
  666.     ["Kill all zombie groups" gnus-group-kill-all-zombies
  667.      gnus-zombie-list]
  668.     ["Kill all groups on level..." gnus-group-kill-level t])
  669.        ("Foreign groups"
  670.     ["Make a foreign group" gnus-group-make-group t]
  671.     ["Add a directory group" gnus-group-make-directory-group t]
  672.     ["Add the help group" gnus-group-make-help-group t]
  673.     ["Add the archive group" gnus-group-make-archive-group t]
  674.     ["Make a doc group" gnus-group-make-doc-group t]
  675.     ["Make a web group" gnus-group-make-web-group t]
  676.     ["Make a kiboze group" gnus-group-make-kiboze-group t]
  677.     ["Make a virtual group" gnus-group-make-empty-virtual t]
  678.     ["Add a group to a virtual" gnus-group-add-to-virtual t]
  679.     ["Rename group" gnus-group-rename-group
  680.      (gnus-check-backend-function
  681.       'request-rename-group (gnus-group-group-name))]
  682.     ["Delete group" gnus-group-delete-group
  683.      (gnus-check-backend-function
  684.       'request-delete-group (gnus-group-group-name))])
  685.        ("Move"
  686.     ["Next" gnus-group-next-group t]
  687.     ["Previous" gnus-group-prev-group t]
  688.     ["Next unread" gnus-group-next-unread-group t]
  689.     ["Previous unread" gnus-group-prev-unread-group t]
  690.     ["Next unread same level" gnus-group-next-unread-group-same-level t]
  691.     ["Previous unread same level"
  692.      gnus-group-prev-unread-group-same-level t]
  693.     ["Jump to group" gnus-group-jump-to-group t]
  694.     ["First unread group" gnus-group-first-unread-group t]
  695.     ["Best unread group" gnus-group-best-unread-group t])
  696.        ["Delete bogus groups" gnus-group-check-bogus-groups t]
  697.        ["Find new newsgroups" gnus-group-find-new-groups t]
  698.        ["Transpose" gnus-group-transpose-groups
  699.     (gnus-group-group-name)]
  700.        ["Read a directory as a group..." gnus-group-enter-directory t]))
  701.  
  702.     (easy-menu-define
  703.      gnus-group-misc-menu gnus-group-mode-map ""
  704.      '("Misc"
  705.        ("SOUP"
  706.     ["Pack replies" nnsoup-pack-replies (fboundp 'nnsoup-request-group)]
  707.     ["Send replies" gnus-soup-send-replies
  708.      (fboundp 'gnus-soup-pack-packet)]
  709.     ["Pack packet" gnus-soup-pack-packet (fboundp 'gnus-soup-pack-packet)]
  710.     ["Save areas" gnus-soup-save-areas (fboundp 'gnus-soup-pack-packet)]
  711.     ["Brew SOUP" gnus-soup-brew-soup (fboundp 'gnus-soup-pack-packet)])
  712.        ["Send a bug report" gnus-bug t]
  713.        ["Send a mail" gnus-group-mail t]
  714.        ["Post an article..." gnus-group-post-news t]
  715.        ["Check for new news" gnus-group-get-new-news t]
  716.        ["Activate all groups" gnus-activate-all-groups t]
  717.        ["Restart Gnus" gnus-group-restart t]
  718.        ["Read init file" gnus-group-read-init-file t]
  719.        ["Browse foreign server" gnus-group-browse-foreign-server t]
  720.        ["Enter server buffer" gnus-group-enter-server-mode t]
  721.        ["Expire all expirable articles" gnus-group-expire-all-groups t]
  722.        ["Generate any kiboze groups" nnkiboze-generate-groups t]
  723.        ["Gnus version" gnus-version t]
  724.        ["Save .newsrc files" gnus-group-save-newsrc t]
  725.        ["Suspend Gnus" gnus-group-suspend t]
  726.        ["Clear dribble buffer" gnus-group-clear-dribble t]
  727.        ["Read manual" gnus-info-find-node t]
  728.        ["Flush score cache" gnus-score-flush-cache t]
  729.        ["Toggle topics" gnus-topic-mode t]
  730.        ["Exit from Gnus" gnus-group-exit t]
  731.        ["Exit without saving" gnus-group-quit t]))
  732.  
  733.     (run-hooks 'gnus-group-menu-hook)))
  734.  
  735. (defun gnus-group-mode ()
  736.   "Major mode for reading news.
  737.  
  738. All normal editing commands are switched off.
  739. \\<gnus-group-mode-map>
  740. The group buffer lists (some of) the groups available.    For instance,
  741. `\\[gnus-group-list-groups]' will list all subscribed groups with unread articles, while `\\[gnus-group-list-zombies]'
  742. lists all zombie groups.
  743.  
  744. Groups that are displayed can be entered with `\\[gnus-group-read-group]'.  To subscribe
  745. to a group not displayed, type `\\[gnus-group-unsubscribe-group]'.
  746.  
  747. For more in-depth information on this mode, read the manual (`\\[gnus-info-find-node]').
  748.  
  749. The following commands are available:
  750.  
  751. \\{gnus-group-mode-map}"
  752.   (interactive)
  753.   (when (gnus-visual-p 'group-menu 'menu)
  754.     (gnus-group-make-menu-bar))
  755.   (kill-all-local-variables)
  756.   (gnus-simplify-mode-line)
  757.   (setq major-mode 'gnus-group-mode)
  758.   (setq mode-name "Group")
  759.   (gnus-group-set-mode-line)
  760.   (setq mode-line-process nil)
  761.   (use-local-map gnus-group-mode-map)
  762.   (buffer-disable-undo (current-buffer))
  763.   (setq truncate-lines t)
  764.   (setq buffer-read-only t)
  765.   (gnus-set-default-directory)
  766.   (gnus-update-format-specifications nil 'group 'group-mode)
  767.   (gnus-update-group-mark-positions)
  768.   (make-local-hook 'post-command-hook)
  769.   (add-hook 'post-command-hook 'gnus-clear-inboxes-moved nil t)
  770.   (when gnus-use-undo
  771.     (gnus-undo-mode 1))
  772.   (run-hooks 'gnus-group-mode-hook))
  773.  
  774. (defun gnus-update-group-mark-positions ()
  775.   (save-excursion
  776.     (let ((gnus-process-mark 128)
  777.       (gnus-group-marked '("dummy.group"))
  778.       (gnus-active-hashtb (make-vector 10 0)))
  779.       (gnus-set-active "dummy.group" '(0 . 0))
  780.       (gnus-set-work-buffer)
  781.       (gnus-group-insert-group-line "dummy.group" 0 nil 0 nil)
  782.       (goto-char (point-min))
  783.       (setq gnus-group-mark-positions
  784.         (list (cons 'process (and (search-forward "\200" nil t)
  785.                       (- (point) 2))))))))
  786.  
  787. (defun gnus-clear-inboxes-moved ()
  788.   (setq nnmail-moved-inboxes nil))
  789.  
  790. (defun gnus-mouse-pick-group (e)
  791.   "Enter the group under the mouse pointer."
  792.   (interactive "e")
  793.   (mouse-set-point e)
  794.   (gnus-group-read-group nil))
  795.  
  796. ;; Look at LEVEL and find out what the level is really supposed to be.
  797. ;; If LEVEL is non-nil, LEVEL will be returned, if not, what happens
  798. ;; will depend on whether `gnus-group-use-permanent-levels' is used.
  799. (defun gnus-group-default-level (&optional level number-or-nil)
  800.   (cond
  801.    (gnus-group-use-permanent-levels
  802.     (or (setq gnus-group-use-permanent-levels
  803.           (or level (if (numberp gnus-group-use-permanent-levels)
  804.                 gnus-group-use-permanent-levels
  805.               (or gnus-group-default-list-level
  806.                   gnus-level-subscribed))))
  807.     gnus-group-default-list-level gnus-level-subscribed))
  808.    (number-or-nil
  809.     level)
  810.    (t
  811.     (or level gnus-group-default-list-level gnus-level-subscribed))))
  812.  
  813. (defun gnus-group-setup-buffer ()
  814.   (switch-to-buffer gnus-group-buffer)
  815.   (unless (eq major-mode 'gnus-group-mode)
  816.     (gnus-add-current-to-buffer-list)
  817.     (gnus-group-mode)
  818.     (when gnus-carpal
  819.       (gnus-carpal-setup-buffer 'group))))
  820.  
  821. (defun gnus-group-list-groups (&optional level unread lowest)
  822.   "List newsgroups with level LEVEL or lower that have unread articles.
  823. Default is all subscribed groups.
  824. If argument UNREAD is non-nil, groups with no unread articles are also
  825. listed.
  826.  
  827. Also see the `gnus-group-use-permanent-levels' variable."
  828.   (interactive
  829.    (list (if current-prefix-arg
  830.          (prefix-numeric-value current-prefix-arg)
  831.        (or
  832.         (gnus-group-default-level nil t)
  833.         gnus-group-default-list-level
  834.         gnus-level-subscribed))))
  835.   ;; Just do this here, for no particular good reason.
  836.   (gnus-clear-inboxes-moved)
  837.   (unless level
  838.     (setq level (car gnus-group-list-mode)
  839.       unread (cdr gnus-group-list-mode)))
  840.   (setq level (gnus-group-default-level level))
  841.   (gnus-group-setup-buffer)
  842.   (gnus-update-format-specifications nil 'group 'group-mode)
  843.   (let ((case-fold-search nil)
  844.     (props (text-properties-at (gnus-point-at-bol)))
  845.     (empty (= (point-min) (point-max)))
  846.     (group (gnus-group-group-name))
  847.     number)
  848.     (set-buffer gnus-group-buffer)
  849.     (setq number (funcall gnus-group-prepare-function level unread lowest))
  850.     (when (or (and (numberp number)
  851.            (zerop number))
  852.           (zerop (buffer-size)))
  853.       ;; No groups in the buffer.
  854.       (gnus-message 5 gnus-no-groups-message))
  855.     ;; We have some groups displayed.
  856.     (goto-char (point-max))
  857.     (when (or (not gnus-group-goto-next-group-function)
  858.           (not (funcall gnus-group-goto-next-group-function
  859.                 group props)))
  860.       (cond
  861.        (empty
  862.     (goto-char (point-min)))
  863.        ((not group)
  864.     ;; Go to the first group with unread articles.
  865.     (gnus-group-search-forward t))
  866.        (t
  867.     ;; Find the right group to put point on.  If the current group
  868.     ;; has disappeared in the new listing, try to find the next
  869.     ;; one.  If no next one can be found, just leave point at the
  870.     ;; first newsgroup in the buffer.
  871.     (when (not (gnus-goto-char
  872.             (text-property-any
  873.              (point-min) (point-max)
  874.              'gnus-group (gnus-intern-safe
  875.                   group gnus-active-hashtb))))
  876.       (let ((newsrc (cdddr (gnus-gethash group gnus-newsrc-hashtb))))
  877.         (while (and newsrc
  878.             (not (gnus-goto-char
  879.                   (text-property-any
  880.                    (point-min) (point-max) 'gnus-group
  881.                    (gnus-intern-safe
  882.                 (caar newsrc) gnus-active-hashtb)))))
  883.           (setq newsrc (cdr newsrc)))
  884.         (unless newsrc
  885.           (goto-char (point-max))
  886.           (forward-line -1)))))))
  887.     ;; Adjust cursor point.
  888.     (gnus-group-position-point)))
  889.  
  890. (defun gnus-group-list-level (level &optional all)
  891.   "List groups on LEVEL.
  892. If ALL (the prefix), also list groups that have no unread articles."
  893.   (interactive "nList groups on level: \nP")
  894.   (gnus-group-list-groups level all level))
  895.  
  896. (defun gnus-group-prepare-flat (level &optional all lowest regexp)
  897.   "List all newsgroups with unread articles of level LEVEL or lower.
  898. If ALL is non-nil, list groups that have no unread articles.
  899. If LOWEST is non-nil, list all newsgroups of level LOWEST or higher.
  900. If REGEXP, only list groups matching REGEXP."
  901.   (set-buffer gnus-group-buffer)
  902.   (let ((buffer-read-only nil)
  903.     (newsrc (cdr gnus-newsrc-alist))
  904.     (lowest (or lowest 1))
  905.     info clevel unread group params)
  906.     (erase-buffer)
  907.     (when (< lowest gnus-level-zombie)
  908.       ;; List living groups.
  909.       (while newsrc
  910.     (setq info (car newsrc)
  911.           group (gnus-info-group info)
  912.           params (gnus-info-params info)
  913.           newsrc (cdr newsrc)
  914.           unread (car (gnus-gethash group gnus-newsrc-hashtb)))
  915.     (and unread            ; This group might be bogus
  916.          (or (not regexp)
  917.          (string-match regexp group))
  918.          (<= (setq clevel (gnus-info-level info)) level)
  919.          (>= clevel lowest)
  920.          (or all            ; We list all groups?
  921.          (if (eq unread t)    ; Unactivated?
  922.              gnus-group-list-inactive-groups ; We list unactivated
  923.            (> unread 0))    ; We list groups with unread articles
  924.          (and gnus-list-groups-with-ticked-articles
  925.               (cdr (assq 'tick (gnus-info-marks info))))
  926.                     ; And groups with tickeds
  927.          ;; Check for permanent visibility.
  928.          (and gnus-permanently-visible-groups
  929.               (string-match gnus-permanently-visible-groups
  930.                     group))
  931.          (memq 'visible params)
  932.          (cdr (assq 'visible params)))
  933.          (gnus-group-insert-group-line
  934.           group (gnus-info-level info)
  935.           (gnus-info-marks info) unread (gnus-info-method info)))))
  936.  
  937.     ;; List dead groups.
  938.     (and (>= level gnus-level-zombie) (<= lowest gnus-level-zombie)
  939.      (gnus-group-prepare-flat-list-dead
  940.       (setq gnus-zombie-list (sort gnus-zombie-list 'string<))
  941.       gnus-level-zombie ?Z
  942.       regexp))
  943.     (and (>= level gnus-level-killed) (<= lowest gnus-level-killed)
  944.      (gnus-group-prepare-flat-list-dead
  945.       (setq gnus-killed-list (sort gnus-killed-list 'string<))
  946.       gnus-level-killed ?K regexp))
  947.  
  948.     (gnus-group-set-mode-line)
  949.     (setq gnus-group-list-mode (cons level all))
  950.     (run-hooks 'gnus-group-prepare-hook)
  951.     t))
  952.  
  953. (defun gnus-group-prepare-flat-list-dead (groups level mark regexp)
  954.   ;; List zombies and killed lists somewhat faster, which was
  955.   ;; suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>.  It does
  956.   ;; this by ignoring the group format specification altogether.
  957.   (let (group)
  958.     (if regexp
  959.     ;; This loop is used when listing groups that match some
  960.     ;; regexp.
  961.     (while groups
  962.       (setq group (pop groups))
  963.       (when (string-match regexp group)
  964.         (gnus-add-text-properties
  965.          (point) (prog1 (1+ (point))
  966.                (insert " " mark "     *: " group "\n"))
  967.          (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)
  968.            'gnus-unread t
  969.            'gnus-level level))))
  970.       ;; This loop is used when listing all groups.
  971.       (while groups
  972.     (gnus-add-text-properties
  973.      (point) (prog1 (1+ (point))
  974.            (insert " " mark "     *: "
  975.                (setq group (pop groups)) "\n"))
  976.      (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)
  977.            'gnus-unread t
  978.            'gnus-level level))))))
  979.  
  980. (defun gnus-group-update-group-line ()
  981.   "Update the current line in the group buffer."
  982.   (let* ((buffer-read-only nil)
  983.      (group (gnus-group-group-name))
  984.      (entry (and group (gnus-gethash group gnus-newsrc-hashtb)))
  985.      gnus-group-indentation)
  986.     (when group
  987.       (and entry
  988.        (not (gnus-ephemeral-group-p group))
  989.        (gnus-dribble-enter
  990.         (concat "(gnus-group-set-info '"
  991.             (gnus-prin1-to-string (nth 2 entry))
  992.             ")")))
  993.       (setq gnus-group-indentation (gnus-group-group-indentation))
  994.       (gnus-delete-line)
  995.       (gnus-group-insert-group-line-info group)
  996.       (forward-line -1)
  997.       (gnus-group-position-point))))
  998.  
  999. (defun gnus-group-insert-group-line-info (group)
  1000.   "Insert GROUP on the current line."
  1001.   (let ((entry (gnus-gethash group gnus-newsrc-hashtb))
  1002.     (gnus-group-indentation (gnus-group-group-indentation))
  1003.     active info)
  1004.     (if entry
  1005.     (progn
  1006.       ;; (Un)subscribed group.
  1007.       (setq info (nth 2 entry))
  1008.       (gnus-group-insert-group-line
  1009.        group (gnus-info-level info) (gnus-info-marks info)
  1010.        (or (car entry) t) (gnus-info-method info)))
  1011.       ;; This group is dead.
  1012.       (gnus-group-insert-group-line
  1013.        group
  1014.        (if (member group gnus-zombie-list) gnus-level-zombie gnus-level-killed)
  1015.        nil
  1016.        (if (setq active (gnus-active group))
  1017.        (if (zerop (cdr active))
  1018.            0
  1019.          (- (1+ (cdr active)) (car active)))
  1020.      nil)
  1021.        nil))))
  1022.  
  1023. (defun gnus-group-insert-group-line (gnus-tmp-group gnus-tmp-level
  1024.                             gnus-tmp-marked number
  1025.                             gnus-tmp-method)
  1026.   "Insert a group line in the group buffer."
  1027.   (let* ((gnus-tmp-active (gnus-active gnus-tmp-group))
  1028.      (gnus-tmp-number-total
  1029.       (if gnus-tmp-active
  1030.           (1+ (- (cdr gnus-tmp-active) (car gnus-tmp-active)))
  1031.         0))
  1032.      (gnus-tmp-number-of-unread
  1033.       (if (numberp number) (int-to-string (max 0 number))
  1034.         "*"))
  1035.      (gnus-tmp-number-of-read
  1036.       (if (numberp number)
  1037.           (int-to-string (max 0 (- gnus-tmp-number-total number)))
  1038.         "*"))
  1039.      (gnus-tmp-subscribed
  1040.       (cond ((<= gnus-tmp-level gnus-level-subscribed) ? )
  1041.         ((<= gnus-tmp-level gnus-level-unsubscribed) ?U)
  1042.         ((= gnus-tmp-level gnus-level-zombie) ?Z)
  1043.         (t ?K)))
  1044.      (gnus-tmp-qualified-group (gnus-group-real-name gnus-tmp-group))
  1045.      (gnus-tmp-newsgroup-description
  1046.       (if gnus-description-hashtb
  1047.           (or (gnus-gethash gnus-tmp-group gnus-description-hashtb) "")
  1048.         ""))
  1049.      (gnus-tmp-moderated
  1050.       (if (and gnus-moderated-hashtb
  1051.            (gnus-gethash gnus-tmp-group gnus-moderated-hashtb))
  1052.           ?m ? ))
  1053.      (gnus-tmp-moderated-string
  1054.       (if (eq gnus-tmp-moderated ?m) "(m)" ""))
  1055.      (gnus-tmp-method
  1056.       (gnus-server-get-method gnus-tmp-group gnus-tmp-method))
  1057.      (gnus-tmp-news-server (or (cadr gnus-tmp-method) ""))
  1058.      (gnus-tmp-news-method (or (car gnus-tmp-method) ""))
  1059.      (gnus-tmp-news-method-string
  1060.       (if gnus-tmp-method
  1061.           (format "(%s:%s)" (car gnus-tmp-method)
  1062.               (cadr gnus-tmp-method)) ""))
  1063.      (gnus-tmp-marked-mark
  1064.       (if (and (numberp number)
  1065.            (zerop number)
  1066.            (cdr (assq 'tick gnus-tmp-marked)))
  1067.           ?* ? ))
  1068.      (gnus-tmp-process-marked
  1069.       (if (member gnus-tmp-group gnus-group-marked)
  1070.           gnus-process-mark ? ))
  1071.      (gnus-tmp-grouplens
  1072.       (or (and gnus-use-grouplens
  1073.            (bbb-grouplens-group-p gnus-tmp-group))
  1074.           ""))
  1075.      (buffer-read-only nil)
  1076.      header gnus-tmp-header)    ; passed as parameter to user-funcs.
  1077.     (beginning-of-line)
  1078.     (gnus-add-text-properties
  1079.      (point)
  1080.      (prog1 (1+ (point))
  1081.        ;; Insert the text.
  1082.        (eval gnus-group-line-format-spec))
  1083.      `(gnus-group ,(gnus-intern-safe gnus-tmp-group gnus-active-hashtb)
  1084.           gnus-unread ,(if (numberp number)
  1085.                    (string-to-int gnus-tmp-number-of-unread)
  1086.                  t)
  1087.           gnus-marked ,gnus-tmp-marked-mark
  1088.           gnus-indentation ,gnus-group-indentation
  1089.           gnus-level ,gnus-tmp-level))
  1090.     (when (inline (gnus-visual-p 'group-highlight 'highlight))
  1091.       (forward-line -1)
  1092.       (run-hooks 'gnus-group-update-hook)
  1093.       (forward-line))
  1094.     ;; Allow XEmacs to remove front-sticky text properties.
  1095.     (gnus-group-remove-excess-properties)))
  1096.  
  1097. (defun gnus-group-highlight-line ()
  1098.   "Highlight the current line according to `gnus-group-highlight'."
  1099.   (let* ((list gnus-group-highlight)
  1100.      (p (point))
  1101.      (end (progn (end-of-line) (point)))
  1102.      ;; now find out where the line starts and leave point there.
  1103.      (beg (progn (beginning-of-line) (point)))
  1104.      (group (gnus-group-group-name))
  1105.      (entry (gnus-group-entry group))
  1106.      (unread (if (numberp (car entry)) (car entry) 0))
  1107.      (active (gnus-active group))
  1108.      (total (if active (1+ (- (cdr active) (car active))) 0))
  1109.      (info (nth 2 entry))
  1110.      (method (gnus-server-get-method group (gnus-info-method info)))
  1111.      (marked (gnus-info-marks info))
  1112.      (mailp (memq 'mail (assoc (symbol-name
  1113.                     (car (or method gnus-select-method)))
  1114.                    gnus-valid-select-methods)))
  1115.      (level (or (gnus-info-level info) 9))
  1116.      (score (or (gnus-info-score info) 0))
  1117.      (ticked (gnus-range-length (cdr (assq 'tick marked))))
  1118.      (group-age (gnus-group-timestamp-delta group))
  1119.      (inhibit-read-only t))
  1120.     ;; Eval the cars of the lists until we find a match.
  1121.     (while (and list
  1122.         (not (eval (caar list))))
  1123.       (setq list (cdr list)))
  1124.     (let ((face (cdar list)))
  1125.       (unless (eq face (get-text-property beg 'face))
  1126.     (gnus-put-text-property
  1127.      beg end 'face
  1128.      (setq face (if (boundp face) (symbol-value face) face)))
  1129.     (gnus-extent-start-open beg)))
  1130.     (goto-char p)))
  1131.  
  1132. (defun gnus-group-update-group (group &optional visible-only)
  1133.   "Update all lines where GROUP appear.
  1134. If VISIBLE-ONLY is non-nil, the group won't be displayed if it isn't
  1135. already."
  1136.   ;; Can't use `save-excursion' here, so we do it manually.
  1137.   (let ((buf (current-buffer))
  1138.     mark)
  1139.     (set-buffer gnus-group-buffer)
  1140.     (setq mark (point-marker))
  1141.     ;; The buffer may be narrowed.
  1142.     (save-restriction
  1143.       (widen)
  1144.       (let ((ident (gnus-intern-safe group gnus-active-hashtb))
  1145.         (loc (point-min))
  1146.         found buffer-read-only)
  1147.     ;; Enter the current status into the dribble buffer.
  1148.     (let ((entry (gnus-gethash group gnus-newsrc-hashtb)))
  1149.       (when (and entry (not (gnus-ephemeral-group-p group)))
  1150.         (gnus-dribble-enter
  1151.          (concat "(gnus-group-set-info '"
  1152.              (gnus-prin1-to-string (nth 2 entry))
  1153.              ")"))))
  1154.     ;; Find all group instances.  If topics are in use, each group
  1155.     ;; may be listed in more than once.
  1156.     (while (setq loc (text-property-any
  1157.               loc (point-max) 'gnus-group ident))
  1158.       (setq found t)
  1159.       (goto-char loc)
  1160.       (let ((gnus-group-indentation (gnus-group-group-indentation)))
  1161.         (gnus-delete-line)
  1162.         (gnus-group-insert-group-line-info group)
  1163.         (save-excursion
  1164.           (forward-line -1)
  1165.           (run-hooks 'gnus-group-update-group-hook)))
  1166.       (setq loc (1+ loc)))
  1167.     (unless (or found visible-only)
  1168.       ;; No such line in the buffer, find out where it's supposed to
  1169.       ;; go, and insert it there (or at the end of the buffer).
  1170.       (if gnus-goto-missing-group-function
  1171.           (funcall gnus-goto-missing-group-function group)
  1172.         (let ((entry (cddr (gnus-gethash group gnus-newsrc-hashtb))))
  1173.           (while (and entry (car entry)
  1174.               (not
  1175.                (gnus-goto-char
  1176.                 (text-property-any
  1177.                  (point-min) (point-max)
  1178.                  'gnus-group (gnus-intern-safe
  1179.                       (caar entry) gnus-active-hashtb)))))
  1180.         (setq entry (cdr entry)))
  1181.           (or entry (goto-char (point-max)))))
  1182.       ;; Finally insert the line.
  1183.       (let ((gnus-group-indentation (gnus-group-group-indentation)))
  1184.         (gnus-group-insert-group-line-info group)
  1185.         (save-excursion
  1186.           (forward-line -1)
  1187.           (run-hooks 'gnus-group-update-group-hook))))
  1188.     (when gnus-group-update-group-function
  1189.       (funcall gnus-group-update-group-function group))
  1190.     (gnus-group-set-mode-line)))
  1191.     (goto-char mark)
  1192.     (set-marker mark nil)
  1193.     (set-buffer buf)))
  1194.  
  1195. (defun gnus-group-set-mode-line ()
  1196.   "Update the mode line in the group buffer."
  1197.   (when (memq 'group gnus-updated-mode-lines)
  1198.     ;; Yes, we want to keep this mode line updated.
  1199.     (save-excursion
  1200.       (set-buffer gnus-group-buffer)
  1201.       (let* ((gformat (or gnus-group-mode-line-format-spec
  1202.               (setq gnus-group-mode-line-format-spec
  1203.                 (gnus-parse-format
  1204.                  gnus-group-mode-line-format
  1205.                  gnus-group-mode-line-format-alist))))
  1206.          (gnus-tmp-news-server (cadr gnus-select-method))
  1207.          (gnus-tmp-news-method (car gnus-select-method))
  1208.          (gnus-tmp-colon (if (equal gnus-tmp-news-server "") "" ":"))
  1209.          (max-len 60)
  1210.          gnus-tmp-header        ;Dummy binding for user-defined formats
  1211.          ;; Get the resulting string.
  1212.          (modified
  1213.           (and gnus-dribble-buffer
  1214.            (buffer-name gnus-dribble-buffer)
  1215.            (buffer-modified-p gnus-dribble-buffer)
  1216.            (save-excursion
  1217.              (set-buffer gnus-dribble-buffer)
  1218.              (not (zerop (buffer-size))))))
  1219.          (mode-string (eval gformat)))
  1220.     ;; Say whether the dribble buffer has been modified.
  1221.     (setq mode-line-modified
  1222.           (if modified (car gnus-mode-line-modified)
  1223.         (cdr gnus-mode-line-modified)))
  1224.     ;; If the line is too long, we chop it off.
  1225.     (when (> (length mode-string) max-len)
  1226.       (setq mode-string (substring mode-string 0 (- max-len 4))))
  1227.     (prog1
  1228.         (setq mode-line-buffer-identification
  1229.           (gnus-mode-line-buffer-identification
  1230.            (list mode-string)))
  1231.       (set-buffer-modified-p modified))))))
  1232.  
  1233. (defun gnus-group-group-name ()
  1234.   "Get the name of the newsgroup on the current line."
  1235.   (let ((group (get-text-property (gnus-point-at-bol) 'gnus-group)))
  1236.     (and group (symbol-name group))))
  1237.  
  1238. (defun gnus-group-group-level ()
  1239.   "Get the level of the newsgroup on the current line."
  1240.   (get-text-property (gnus-point-at-bol) 'gnus-level))
  1241.  
  1242. (defun gnus-group-group-indentation ()
  1243.   "Get the indentation of the newsgroup on the current line."
  1244.   (or (get-text-property (gnus-point-at-bol) 'gnus-indentation)
  1245.       (and gnus-group-indentation-function
  1246.        (funcall gnus-group-indentation-function))
  1247.       ""))
  1248.  
  1249. (defun gnus-group-group-unread ()
  1250.   "Get the number of unread articles of the newsgroup on the current line."
  1251.   (get-text-property (gnus-point-at-bol) 'gnus-unread))
  1252.  
  1253. (defun gnus-group-new-mail (group)
  1254.   (if (nnmail-new-mail-p (gnus-group-real-name group))
  1255.       gnus-new-mail-mark
  1256.     ? ))
  1257.  
  1258. (defun gnus-group-level (group)
  1259.   "Return the estimated level of GROUP."
  1260.   (or (gnus-info-level (gnus-get-info group))
  1261.       (and (member group gnus-zombie-list) 8)
  1262.       9))
  1263.  
  1264. (defun gnus-group-search-forward (&optional backward all level first-too)
  1265.   "Find the next newsgroup with unread articles.
  1266. If BACKWARD is non-nil, find the previous newsgroup instead.
  1267. If ALL is non-nil, just find any newsgroup.
  1268. If LEVEL is non-nil, find group with level LEVEL, or higher if no such
  1269. group exists.
  1270. If FIRST-TOO, the current line is also eligible as a target."
  1271.   (let ((way (if backward -1 1))
  1272.     (low gnus-level-killed)
  1273.     (beg (point))
  1274.     pos found lev)
  1275.     (if (and backward (progn (beginning-of-line)) (bobp))
  1276.     nil
  1277.       (unless first-too
  1278.     (forward-line way))
  1279.       (while (and
  1280.           (not (eobp))
  1281.           (not (setq
  1282.             found
  1283.             (and
  1284.              (get-text-property (point) 'gnus-group)
  1285.              (or all
  1286.              (and
  1287.               (let ((unread
  1288.                  (get-text-property (point) 'gnus-unread)))
  1289.                 (and (numberp unread) (> unread 0)))
  1290.               (setq lev (get-text-property (point)
  1291.                                'gnus-level))
  1292.               (<= lev gnus-level-subscribed)))
  1293.              (or (not level)
  1294.              (and (setq lev (get-text-property (point)
  1295.                                'gnus-level))
  1296.                   (or (= lev level)
  1297.                   (and (< lev low)
  1298.                        (< level lev)
  1299.                        (progn
  1300.                      (setq low lev)
  1301.                      (setq pos (point))
  1302.                      nil))))))))
  1303.           (zerop (forward-line way)))))
  1304.     (if found
  1305.     (progn (gnus-group-position-point) t)
  1306.       (goto-char (or pos beg))
  1307.       (and pos t))))
  1308.  
  1309. ;;; Gnus group mode commands
  1310.  
  1311. ;; Group marking.
  1312.  
  1313. (defun gnus-group-mark-group (n &optional unmark no-advance)
  1314.   "Mark the current group."
  1315.   (interactive "p")
  1316.   (let ((buffer-read-only nil)
  1317.     group)
  1318.     (while (and (> n 0)
  1319.         (not (eobp)))
  1320.       (when (setq group (gnus-group-group-name))
  1321.     ;; Go to the mark position.
  1322.     (beginning-of-line)
  1323.     (forward-char (or (cdr (assq 'process gnus-group-mark-positions)) 2))
  1324.     (subst-char-in-region
  1325.      (point) (1+ (point)) (following-char)
  1326.      (if unmark
  1327.          (progn
  1328.            (setq gnus-group-marked (delete group gnus-group-marked))
  1329.            ? )
  1330.        (setq gnus-group-marked
  1331.          (cons group (delete group gnus-group-marked)))
  1332.        gnus-process-mark)))
  1333.       (unless no-advance
  1334.     (gnus-group-next-group 1))
  1335.       (decf n))
  1336.     (gnus-summary-position-point)
  1337.     n))
  1338.  
  1339. (defun gnus-group-unmark-group (n)
  1340.   "Remove the mark from the current group."
  1341.   (interactive "p")
  1342.   (gnus-group-mark-group n 'unmark)
  1343.   (gnus-group-position-point))
  1344.  
  1345. (defun gnus-group-unmark-all-groups ()
  1346.   "Unmark all groups."
  1347.   (interactive)
  1348.   (let ((groups gnus-group-marked))
  1349.     (save-excursion
  1350.       (while groups
  1351.     (gnus-group-remove-mark (pop groups)))))
  1352.   (gnus-group-position-point))
  1353.  
  1354. (defun gnus-group-mark-region (unmark beg end)
  1355.   "Mark all groups between point and mark.
  1356. If UNMARK, remove the mark instead."
  1357.   (interactive "P\nr")
  1358.   (let ((num (count-lines beg end)))
  1359.     (save-excursion
  1360.       (goto-char beg)
  1361.       (- num (gnus-group-mark-group num unmark)))))
  1362.  
  1363. (defun gnus-group-mark-buffer (&optional unmark)
  1364.   "Mark all groups in the buffer.
  1365. If UNMARK, remove the mark instead."
  1366.   (interactive "P")
  1367.   (gnus-group-mark-region unmark (point-min) (point-max)))
  1368.  
  1369. (defun gnus-group-mark-regexp (regexp)
  1370.   "Mark all groups that match some regexp."
  1371.   (interactive "sMark (regexp): ")
  1372.   (let ((alist (cdr gnus-newsrc-alist))
  1373.     group)
  1374.     (while alist
  1375.       (when (string-match regexp (setq group (gnus-info-group (pop alist))))
  1376.     (gnus-group-set-mark group))))
  1377.   (gnus-group-position-point))
  1378.  
  1379. (defun gnus-group-remove-mark (group)
  1380.   "Remove the process mark from GROUP and move point there.
  1381. Return nil if the group isn't displayed."
  1382.   (if (gnus-group-goto-group group)
  1383.       (save-excursion
  1384.     (gnus-group-mark-group 1 'unmark t)
  1385.     t)
  1386.     (setq gnus-group-marked
  1387.       (delete group gnus-group-marked))
  1388.     nil))
  1389.  
  1390. (defun gnus-group-set-mark (group)
  1391.   "Set the process mark on GROUP."
  1392.   (if (gnus-group-goto-group group)
  1393.       (save-excursion
  1394.     (gnus-group-mark-group 1 nil t))
  1395.     (setq gnus-group-marked (cons group (delete group gnus-group-marked)))))
  1396.  
  1397. (defun gnus-group-universal-argument (arg &optional groups func)
  1398.   "Perform any command on all groups according to the process/prefix convention."
  1399.   (interactive "P")
  1400.   (if (eq (setq func (or func
  1401.              (key-binding
  1402.               (read-key-sequence
  1403.                (substitute-command-keys
  1404.                 "\\<gnus-group-mode-map>\\[gnus-group-universal-argument]")))))
  1405.       'undefined)
  1406.       (gnus-error 1 "Undefined key")
  1407.     (gnus-group-iterate arg
  1408.       (lambda (group)
  1409.     (command-execute func))))
  1410.   (gnus-group-position-point))
  1411.  
  1412. (defun gnus-group-process-prefix (n)
  1413.   "Return a list of groups to work on.
  1414. Take into consideration N (the prefix) and the list of marked groups."
  1415.   (cond
  1416.    (n
  1417.     (setq n (prefix-numeric-value n))
  1418.     ;; There is a prefix, so we return a list of the N next
  1419.     ;; groups.
  1420.     (let ((way (if (< n 0) -1 1))
  1421.       (n (abs n))
  1422.       group groups)
  1423.       (save-excursion
  1424.     (while (and (> n 0)
  1425.             (setq group (gnus-group-group-name)))
  1426.       (push group groups)
  1427.       (setq n (1- n))
  1428.       (gnus-group-next-group way)))
  1429.       (nreverse groups)))
  1430.    ((gnus-region-active-p)
  1431.     ;; Work on the region between point and mark.
  1432.     (let ((max (max (point) (mark)))
  1433.       groups)
  1434.       (save-excursion
  1435.     (goto-char (min (point) (mark)))
  1436.     (while
  1437.         (and
  1438.          (push (gnus-group-group-name) groups)
  1439.          (zerop (gnus-group-next-group 1))
  1440.          (< (point) max)))
  1441.     (nreverse groups))))
  1442.    (gnus-group-marked
  1443.     ;; No prefix, but a list of marked articles.
  1444.     (reverse gnus-group-marked))
  1445.    (t
  1446.     ;; Neither marked articles or a prefix, so we return the
  1447.     ;; current group.
  1448.     (let ((group (gnus-group-group-name)))
  1449.       (and group (list group))))))
  1450.  
  1451. (defun gnus-group-iterate (arg function)
  1452.   "Iterate FUNCTION over all process/prefixed groups.
  1453. FUNCTION will be called with the group name as the paremeter
  1454. and with point over the group in question."
  1455.   (let ((groups (gnus-group-process-prefix arg))
  1456.     (window (selected-window))
  1457.     group)
  1458.     (while (setq group (pop groups))
  1459.       (select-window window)
  1460.       (gnus-group-remove-mark group)
  1461.       (save-selected-window
  1462.     (save-excursion
  1463.       (funcall function group))))))
  1464.  
  1465. (put 'gnus-group-iterate 'lisp-indent-function 1)
  1466.  
  1467. ;; Selecting groups.
  1468.  
  1469. (defun gnus-group-read-group (&optional all no-article group)
  1470.   "Read news in this newsgroup.
  1471. If the prefix argument ALL is non-nil, already read articles become
  1472. readable.  IF ALL is a number, fetch this number of articles.  If the
  1473. optional argument NO-ARTICLE is non-nil, no article will be
  1474. auto-selected upon group entry.     If GROUP is non-nil, fetch that
  1475. group."
  1476.   (interactive "P")
  1477.   (let ((no-display (eq all 0))
  1478.     (group (or group (gnus-group-group-name)))
  1479.     number active marked entry)
  1480.     (when (eq all 0)
  1481.       (setq all nil))
  1482.     (unless group
  1483.       (error "No group on current line"))
  1484.     (setq marked (gnus-info-marks
  1485.           (nth 2 (setq entry (gnus-gethash
  1486.                       group gnus-newsrc-hashtb)))))
  1487.     ;; This group might be a dead group.  In that case we have to get
  1488.     ;; the number of unread articles from `gnus-active-hashtb'.
  1489.     (setq number
  1490.       (cond ((numberp all) all)
  1491.         (entry (car entry))
  1492.         ((setq active (gnus-active group))
  1493.          (- (1+ (cdr active)) (car active)))))
  1494.     (gnus-summary-read-group
  1495.      group (or all (and (numberp number)
  1496.             (zerop (+ number (gnus-range-length
  1497.                       (cdr (assq 'tick marked)))
  1498.                   (gnus-range-length
  1499.                    (cdr (assq 'dormant marked)))))))
  1500.      no-article nil no-display)))
  1501.  
  1502. (defun gnus-group-select-group (&optional all)
  1503.   "Select this newsgroup.
  1504. No article is selected automatically.
  1505. If ALL is non-nil, already read articles become readable.
  1506. If ALL is a number, fetch this number of articles."
  1507.   (interactive "P")
  1508.   (gnus-group-read-group all t))
  1509.  
  1510. (defun gnus-group-quick-select-group (&optional all)
  1511.   "Select the current group \"quickly\".
  1512. This means that no highlighting or scoring will be performed.
  1513. If ALL (the prefix argument) is 0, don't even generate the summary
  1514. buffer."
  1515.   (interactive "P")
  1516.   (require 'gnus-score)
  1517.   (let (gnus-visual
  1518.     gnus-score-find-score-files-function
  1519.     gnus-home-score-file
  1520.     gnus-apply-kill-hook
  1521.     gnus-summary-expunge-below)
  1522.     (gnus-group-read-group all t)))
  1523.  
  1524. (defun gnus-group-visible-select-group (&optional all)
  1525.   "Select the current group without hiding any articles."
  1526.   (interactive "P")
  1527.   (let ((gnus-inhibit-limiting t))
  1528.     (gnus-group-read-group all t)))
  1529.  
  1530. (defun gnus-group-select-group-ephemerally ()
  1531.   "Select the current group without doing any processing whatsoever.
  1532. You will actually be entered into a group that's a copy of
  1533. the current group; no changes you make while in this group will
  1534. be permanent."
  1535.   (interactive)
  1536.   (require 'gnus-score)
  1537.   (let* (gnus-visual
  1538.      gnus-score-find-score-files-function gnus-apply-kill-hook
  1539.      gnus-summary-expunge-below gnus-show-threads gnus-suppress-duplicates
  1540.      gnus-summary-mode-hook gnus-select-group-hook
  1541.      (group (gnus-group-group-name))
  1542.      (method (gnus-find-method-for-group group)))
  1543.     (setq method
  1544.       `(,(car method) ,(concat (cadr method) "-ephemeral")
  1545.         (,(intern (format "%s-address" (car method))) ,(cadr method))
  1546.         ,@(cddr method)))
  1547.     (gnus-group-read-ephemeral-group
  1548.      (gnus-group-prefixed-name group method) method)))
  1549.  
  1550. ;;;###autoload
  1551. (defun gnus-fetch-group (group)
  1552.   "Start Gnus if necessary and enter GROUP.
  1553. Returns whether the fetching was successful or not."
  1554.   (interactive "sGroup name: ")
  1555.   (unless (get-buffer gnus-group-buffer)
  1556.     (gnus))
  1557.   (gnus-group-read-group nil nil group))
  1558.  
  1559. (defvar gnus-ephemeral-group-server 0)
  1560.  
  1561. ;; Enter a group that is not in the group buffer.  Non-nil is returned
  1562. ;; if selection was successful.
  1563. (defun gnus-group-read-ephemeral-group (group method &optional activate
  1564.                           quit-config request-only)
  1565.   "Read GROUP from METHOD as an ephemeral group.
  1566. If ACTIVATE, request the group first.
  1567. If QUIT-CONFIG, use that window configuration when exiting from the
  1568. ephemeral group.
  1569. If REQUEST-ONLY, don't actually read the group; just request it.
  1570.  
  1571. Return the name of the group is selection was successful."
  1572.   ;; Transform the select method into a unique server.
  1573.   (let ((saddr (intern (format "%s-address" (car method)))))
  1574.     (setq method (gnus-copy-sequence method))
  1575.     (require (car method))
  1576.     (when (boundp saddr)
  1577.       (unless (assq saddr method)
  1578.     (nconc method `((,saddr ,(cadr method))))
  1579.     (setf (cadr method) (format "%s-%d" (cadr method)
  1580.                     (incf gnus-ephemeral-group-server))))))
  1581.   (let ((group (if (gnus-group-foreign-p group) group
  1582.          (gnus-group-prefixed-name group method))))
  1583.     (gnus-sethash
  1584.      group
  1585.      `(-1 nil (,group
  1586.            ,gnus-level-default-subscribed nil nil ,method
  1587.            ((quit-config .
  1588.                  ,(if quit-config quit-config
  1589.                 (cons gnus-summary-buffer
  1590.                       gnus-current-window-configuration))))))
  1591.      gnus-newsrc-hashtb)
  1592.     (set-buffer gnus-group-buffer)
  1593.     (unless (gnus-check-server method)
  1594.       (error "Unable to contact server: %s" (gnus-status-message method)))
  1595.     (when activate
  1596.       (gnus-activate-group group 'scan)
  1597.       (unless (gnus-request-group group)
  1598.     (error "Couldn't request group: %s"
  1599.            (nnheader-get-report (car method)))))
  1600.     (if request-only
  1601.     group
  1602.       (condition-case ()
  1603.       (when (gnus-group-read-group t t group)
  1604.         group)
  1605.     ;;(error nil)
  1606.     (quit nil)))))
  1607.  
  1608. (defun gnus-group-jump-to-group (group)
  1609.   "Jump to newsgroup GROUP."
  1610.   (interactive
  1611.    (list (completing-read
  1612.       "Group: " gnus-active-hashtb nil
  1613.       (gnus-read-active-file-p)
  1614.       nil
  1615.       'gnus-group-history)))
  1616.  
  1617.   (when (equal group "")
  1618.     (error "Empty group name"))
  1619.  
  1620.   (unless (gnus-ephemeral-group-p group)
  1621.     ;; Either go to the line in the group buffer...
  1622.     (unless (gnus-group-goto-group group)
  1623.       ;; ... or insert the line.
  1624.       (gnus-group-update-group group)
  1625.       (gnus-group-goto-group group)))
  1626.   ;; Adjust cursor point.
  1627.   (gnus-group-position-point))
  1628.  
  1629. (defun gnus-group-goto-group (group &optional far)
  1630.   "Goto to newsgroup GROUP.
  1631. If FAR, it is likely that the group is not on the current line."
  1632.   (when group
  1633.     (if far
  1634.     (gnus-goto-char
  1635.      (text-property-any
  1636.       (point-min) (point-max)
  1637.       'gnus-group (gnus-intern-safe group gnus-active-hashtb)))
  1638.       (beginning-of-line)
  1639.       (cond
  1640.        ;; It's quite likely that we are on the right line, so
  1641.        ;; we check the current line first.
  1642.        ((eq (get-text-property (point) 'gnus-group)
  1643.         (gnus-intern-safe group gnus-active-hashtb))
  1644.     (point))
  1645.        ;; Previous and next line are also likely, so we check them as well.
  1646.        ((save-excursion
  1647.       (forward-line -1)
  1648.       (eq (get-text-property (point) 'gnus-group)
  1649.           (gnus-intern-safe group gnus-active-hashtb)))
  1650.     (forward-line -1)
  1651.     (point))
  1652.        ((save-excursion
  1653.       (forward-line 1)
  1654.       (eq (get-text-property (point) 'gnus-group)
  1655.           (gnus-intern-safe group gnus-active-hashtb)))
  1656.     (forward-line 1)
  1657.     (point))
  1658.        (t
  1659.     ;; Search through the entire buffer.
  1660.     (gnus-goto-char
  1661.      (text-property-any
  1662.       (point-min) (point-max)
  1663.       'gnus-group (gnus-intern-safe group gnus-active-hashtb))))))))
  1664.  
  1665. (defun gnus-group-next-group (n &optional silent)
  1666.   "Go to next N'th newsgroup.
  1667. If N is negative, search backward instead.
  1668. Returns the difference between N and the number of skips actually
  1669. done."
  1670.   (interactive "p")
  1671.   (gnus-group-next-unread-group n t nil silent))
  1672.  
  1673. (defun gnus-group-next-unread-group (n &optional all level silent)
  1674.   "Go to next N'th unread newsgroup.
  1675. If N is negative, search backward instead.
  1676. If ALL is non-nil, choose any newsgroup, unread or not.
  1677. If LEVEL is non-nil, choose the next group with level LEVEL, or, if no
  1678. such group can be found, the next group with a level higher than
  1679. LEVEL.
  1680. Returns the difference between N and the number of skips actually
  1681. made."
  1682.   (interactive "p")
  1683.   (let ((backward (< n 0))
  1684.     (n (abs n)))
  1685.     (while (and (> n 0)
  1686.         (gnus-group-search-forward
  1687.          backward (or (not gnus-group-goto-unread) all) level))
  1688.       (setq n (1- n)))
  1689.     (when (and (/= 0 n)
  1690.            (not silent))
  1691.       (gnus-message 7 "No more%s newsgroups%s" (if all "" " unread")
  1692.             (if level " on this level or higher" "")))
  1693.     n))
  1694.  
  1695. (defun gnus-group-prev-group (n)
  1696.   "Go to previous N'th newsgroup.
  1697. Returns the difference between N and the number of skips actually
  1698. done."
  1699.   (interactive "p")
  1700.   (gnus-group-next-unread-group (- n) t))
  1701.  
  1702. (defun gnus-group-prev-unread-group (n)
  1703.   "Go to previous N'th unread newsgroup.
  1704. Returns the difference between N and the number of skips actually
  1705. done."
  1706.   (interactive "p")
  1707.   (gnus-group-next-unread-group (- n)))
  1708.  
  1709. (defun gnus-group-next-unread-group-same-level (n)
  1710.   "Go to next N'th unread newsgroup on the same level.
  1711. If N is negative, search backward instead.
  1712. Returns the difference between N and the number of skips actually
  1713. done."
  1714.   (interactive "p")
  1715.   (gnus-group-next-unread-group n t (gnus-group-group-level))
  1716.   (gnus-group-position-point))
  1717.  
  1718. (defun gnus-group-prev-unread-group-same-level (n)
  1719.   "Go to next N'th unread newsgroup on the same level.
  1720. Returns the difference between N and the number of skips actually
  1721. done."
  1722.   (interactive "p")
  1723.   (gnus-group-next-unread-group (- n) t (gnus-group-group-level))
  1724.   (gnus-group-position-point))
  1725.  
  1726. (defun gnus-group-best-unread-group (&optional exclude-group)
  1727.   "Go to the group with the highest level.
  1728. If EXCLUDE-GROUP, do not go to that group."
  1729.   (interactive)
  1730.   (goto-char (point-min))
  1731.   (let ((best 100000)
  1732.     unread best-point)
  1733.     (while (not (eobp))
  1734.       (setq unread (get-text-property (point) 'gnus-unread))
  1735.       (when (and (numberp unread) (> unread 0))
  1736.     (when (and (get-text-property (point) 'gnus-level)
  1737.            (< (get-text-property (point) 'gnus-level) best)
  1738.            (or (not exclude-group)
  1739.                (not (equal exclude-group (gnus-group-group-name)))))
  1740.       (setq best (get-text-property (point) 'gnus-level))
  1741.       (setq best-point (point))))
  1742.       (forward-line 1))
  1743.     (when best-point
  1744.       (goto-char best-point))
  1745.     (gnus-summary-position-point)
  1746.     (and best-point (gnus-group-group-name))))
  1747.  
  1748. (defun gnus-group-first-unread-group ()
  1749.   "Go to the first group with unread articles."
  1750.   (interactive)
  1751.   (prog1
  1752.       (let ((opoint (point))
  1753.         unread)
  1754.     (goto-char (point-min))
  1755.     (if (or (eq (setq unread (gnus-group-group-unread)) t) ; Not active.
  1756.         (and (numberp unread)    ; Not a topic.
  1757.              (not (zerop unread))) ; Has unread articles.
  1758.         (zerop (gnus-group-next-unread-group 1))) ; Next unread group.
  1759.         (point)            ; Success.
  1760.       (goto-char opoint)
  1761.       nil))                ; Not success.
  1762.     (gnus-group-position-point)))
  1763.  
  1764. (defun gnus-group-enter-server-mode ()
  1765.   "Jump to the server buffer."
  1766.   (interactive)
  1767.   (gnus-enter-server-buffer))
  1768.  
  1769. (defun gnus-group-make-group (name &optional method address args)
  1770.   "Add a new newsgroup.
  1771. The user will be prompted for a NAME, for a select METHOD, and an
  1772. ADDRESS."
  1773.   (interactive
  1774.    (list
  1775.     (gnus-read-group "Group name: ")
  1776.     (gnus-read-method "From method: ")))
  1777.  
  1778.   (let* ((meth (when (and method
  1779.               (not (gnus-server-equal method gnus-select-method)))
  1780.          (if address (list (intern method) address)
  1781.            method)))
  1782.      (nname (if method (gnus-group-prefixed-name name meth) name))
  1783.      backend info)
  1784.     (when (gnus-gethash nname gnus-newsrc-hashtb)
  1785.       (error "Group %s already exists" nname))
  1786.     ;; Subscribe to the new group.
  1787.     (gnus-group-change-level
  1788.      (setq info (list t nname gnus-level-default-subscribed nil nil meth))
  1789.      gnus-level-default-subscribed gnus-level-killed
  1790.      (and (gnus-group-group-name)
  1791.       (gnus-gethash (gnus-group-group-name)
  1792.             gnus-newsrc-hashtb))
  1793.      t)
  1794.     ;; Make it active.
  1795.     (gnus-set-active nname (cons 1 0))
  1796.     (unless (gnus-ephemeral-group-p name)
  1797.       (gnus-dribble-enter
  1798.        (concat "(gnus-group-set-info '"
  1799.            (gnus-prin1-to-string (cdr info)) ")")))
  1800.     ;; Insert the line.
  1801.     (gnus-group-insert-group-line-info nname)
  1802.     (forward-line -1)
  1803.     (gnus-group-position-point)
  1804.  
  1805.     ;; Load the backend and try to make the backend create
  1806.     ;; the group as well.
  1807.     (when (assoc (symbol-name (setq backend (car (gnus-server-get-method
  1808.                           nil meth))))
  1809.          gnus-valid-select-methods)
  1810.       (require backend))
  1811.     (gnus-check-server meth)
  1812.     (when (gnus-check-backend-function 'request-create-group nname)
  1813.       (gnus-request-create-group nname nil args))
  1814.     t))
  1815.  
  1816. (defun gnus-group-delete-group (group &optional force)
  1817.   "Delete the current group.  Only meaningful with mail groups.
  1818. If FORCE (the prefix) is non-nil, all the articles in the group will
  1819. be deleted.  This is \"deleted\" as in \"removed forever from the face
  1820. of the Earth\".     There is no undo.  The user will be prompted before
  1821. doing the deletion."
  1822.   (interactive
  1823.    (list (gnus-group-group-name)
  1824.      current-prefix-arg))
  1825.   (unless group
  1826.     (error "No group to rename"))
  1827.   (unless (gnus-check-backend-function 'request-delete-group group)
  1828.     (error "This backend does not support group deletion"))
  1829.   (prog1
  1830.       (if (not (gnus-yes-or-no-p
  1831.         (format
  1832.          "Do you really want to delete %s%s? "
  1833.          group (if force " and all its contents" ""))))
  1834.       ()                ; Whew!
  1835.     (gnus-message 6 "Deleting group %s..." group)
  1836.     (if (not (gnus-request-delete-group group force))
  1837.         (gnus-error 3 "Couldn't delete group %s" group)
  1838.       (gnus-message 6 "Deleting group %s...done" group)
  1839.       (gnus-group-goto-group group)
  1840.       (gnus-group-kill-group 1 t)
  1841.       (gnus-sethash group nil gnus-active-hashtb)
  1842.       t))
  1843.     (gnus-group-position-point)))
  1844.  
  1845. (defun gnus-group-rename-group (group new-name)
  1846.   "Rename group from GROUP to NEW-NAME.
  1847. When used interactively, GROUP is the group under point
  1848. and NEW-NAME will be prompted for."
  1849.   (interactive
  1850.    (list
  1851.     (gnus-group-group-name)
  1852.     (progn
  1853.       (unless (gnus-check-backend-function
  1854.            'request-rename-group (gnus-group-group-name))
  1855.     (error "This backend does not support renaming groups"))
  1856.       (gnus-read-group "Rename group to: "
  1857.                (gnus-group-real-name (gnus-group-group-name))))))
  1858.  
  1859.   (unless (gnus-check-backend-function 'request-rename-group group)
  1860.     (error "This backend does not support renaming groups"))
  1861.   (unless group
  1862.     (error "No group to rename"))
  1863.   (when (equal (gnus-group-real-name group) new-name)
  1864.     (error "Can't rename to the same name"))
  1865.  
  1866.   ;; We find the proper prefixed name.
  1867.   (setq new-name
  1868.     (if (gnus-group-native-p group)
  1869.         ;; Native group.
  1870.         new-name
  1871.       ;; Foreign group.
  1872.       (gnus-group-prefixed-name
  1873.        (gnus-group-real-name new-name)
  1874.        (gnus-info-method (gnus-get-info group)))))
  1875.  
  1876.   (gnus-message 6 "Renaming group %s to %s..." group new-name)
  1877.   (prog1
  1878.       (if (not (gnus-request-rename-group group new-name))
  1879.       (gnus-error 3 "Couldn't rename group %s to %s" group new-name)
  1880.     ;; We rename the group internally by killing it...
  1881.     (gnus-group-goto-group group)
  1882.     (gnus-group-kill-group)
  1883.     ;; ... changing its name ...
  1884.     (setcar (cdar gnus-list-of-killed-groups) new-name)
  1885.     ;; ... and then yanking it.  Magic!
  1886.     (gnus-group-yank-group)
  1887.     (gnus-set-active new-name (gnus-active group))
  1888.     (gnus-message 6 "Renaming group %s to %s...done" group new-name)
  1889.     new-name)
  1890.     (gnus-group-position-point)))
  1891.  
  1892. (defun gnus-group-edit-group (group &optional part)
  1893.   "Edit the group on the current line."
  1894.   (interactive (list (gnus-group-group-name)))
  1895.   (let ((part (or part 'info))
  1896.     info)
  1897.     (unless group
  1898.       (error "No group on current line"))
  1899.     (unless (setq info (gnus-get-info group))
  1900.       (error "Killed group; can't be edited"))
  1901.     (ignore-errors
  1902.       (gnus-close-group group))
  1903.     (gnus-edit-form
  1904.      ;; Find the proper form to edit.
  1905.      (cond ((eq part 'method)
  1906.         (or (gnus-info-method info) "native"))
  1907.        ((eq part 'params)
  1908.         (gnus-info-params info))
  1909.        (t info))
  1910.      ;; The proper documentation.
  1911.      (format
  1912.       "Editing the %s for `%s'."
  1913.       (cond
  1914.        ((eq part 'method) "select method")
  1915.        ((eq part 'params) "group parameters")
  1916.        (t "group info"))
  1917.       group)
  1918.      `(lambda (form)
  1919.     (gnus-group-edit-group-done ',part ,group form)))))
  1920.  
  1921. (defun gnus-group-edit-group-method (group)
  1922.   "Edit the select method of GROUP."
  1923.   (interactive (list (gnus-group-group-name)))
  1924.   (gnus-group-edit-group group 'method))
  1925.  
  1926. (defun gnus-group-edit-group-parameters (group)
  1927.   "Edit the group parameters of GROUP."
  1928.   (interactive (list (gnus-group-group-name)))
  1929.   (gnus-group-edit-group group 'params))
  1930.  
  1931. (defun gnus-group-edit-group-done (part group form)
  1932.   "Update variables."
  1933.   (let* ((method (cond ((eq part 'info) (nth 4 form))
  1934.                ((eq part 'method) form)
  1935.                (t nil)))
  1936.      (info (cond ((eq part 'info) form)
  1937.              ((eq part 'method) (gnus-get-info group))
  1938.              (t nil)))
  1939.      (new-group (if info
  1940.             (if (or (not method)
  1941.                 (gnus-server-equal
  1942.                  gnus-select-method method))
  1943.                 (gnus-group-real-name (car info))
  1944.               (gnus-group-prefixed-name
  1945.                (gnus-group-real-name (car info)) method))
  1946.               nil)))
  1947.     (when (and new-group
  1948.            (not (equal new-group group)))
  1949.       (when (gnus-group-goto-group group)
  1950.     (gnus-group-kill-group 1))
  1951.       (gnus-activate-group new-group))
  1952.     ;; Set the info.
  1953.     (if (not (and info new-group))
  1954.     (gnus-group-set-info form (or new-group group) part)
  1955.       (setq info (gnus-copy-sequence info))
  1956.       (setcar info new-group)
  1957.       (unless (gnus-server-equal method "native")
  1958.     (unless (nthcdr 3 info)
  1959.       (nconc info (list nil nil)))
  1960.     (unless (nthcdr 4 info)
  1961.       (nconc info (list nil)))
  1962.     (gnus-info-set-method info method))
  1963.       (gnus-group-set-info info))
  1964.     (gnus-group-update-group (or new-group group))
  1965.     (gnus-group-position-point)))
  1966.  
  1967. (defun gnus-group-make-useful-group (group method)
  1968.   (interactive
  1969.    (let ((entry (assoc (completing-read "Create group: " gnus-useful-groups
  1970.                     nil t)
  1971.                gnus-useful-groups)))
  1972.      (list (cadr entry) (caddr entry))))
  1973.   (setq method (gnus-copy-sequence method))
  1974.   (let (entry)
  1975.     (while (setq entry (memq (assq 'eval method) method))
  1976.       (setcar entry (eval (cadar entry)))))
  1977.   (gnus-group-make-group group method))
  1978.  
  1979. (defun gnus-group-make-help-group ()
  1980.   "Create the Gnus documentation group."
  1981.   (interactive)
  1982.   (let ((name (gnus-group-prefixed-name "gnus-help" '(nndoc "gnus-help")))
  1983.     (file (nnheader-find-etc-directory "gnus-tut.txt" t))
  1984.     dir)
  1985.     (when (gnus-gethash name gnus-newsrc-hashtb)
  1986.       (error "Documentation group already exists"))
  1987.     (if (not file)
  1988.     (gnus-message 1 "Couldn't find doc group")
  1989.       (gnus-group-make-group
  1990.        (gnus-group-real-name name)
  1991.        (list 'nndoc "gnus-help"
  1992.          (list 'nndoc-address file)
  1993.          (list 'nndoc-article-type 'mbox)))))
  1994.   (gnus-group-position-point))
  1995.  
  1996. (defun gnus-group-make-doc-group (file type)
  1997.   "Create a group that uses a single file as the source."
  1998.   (interactive
  1999.    (list (read-file-name "File name: ")
  2000.      (and current-prefix-arg 'ask)))
  2001.   (when (eq type 'ask)
  2002.     (let ((err "")
  2003.       char found)
  2004.       (while (not found)
  2005.     (message
  2006.      "%sFile type (mbox, babyl, digest, forward, mmdf, guess) [mbdfag]: "
  2007.      err)
  2008.     (setq found (cond ((= (setq char (read-char)) ?m) 'mbox)
  2009.               ((= char ?b) 'babyl)
  2010.               ((= char ?d) 'digest)
  2011.               ((= char ?f) 'forward)
  2012.               ((= char ?a) 'mmfd)
  2013.               (t (setq err (format "%c unknown. " char))
  2014.                  nil))))
  2015.       (setq type found)))
  2016.   (let* ((file (expand-file-name file))
  2017.      (name (gnus-generate-new-group-name
  2018.         (gnus-group-prefixed-name
  2019.          (file-name-nondirectory file) '(nndoc "")))))
  2020.     (gnus-group-make-group
  2021.      (gnus-group-real-name name)
  2022.      (list 'nndoc file
  2023.        (list 'nndoc-address file)
  2024.        (list 'nndoc-article-type (or type 'guess))))))
  2025.  
  2026. (defvar nnweb-type-definition)
  2027. (defvar gnus-group-web-type-history nil)
  2028. (defvar gnus-group-web-search-history nil)
  2029. (defun gnus-group-make-web-group (&optional solid)
  2030.   "Create an ephemeral nnweb group.
  2031. If SOLID (the prefix), create a solid group."
  2032.   (interactive "P")
  2033.   (require 'nnweb)
  2034.   (let* ((group
  2035.       (if solid (gnus-read-group "Group name: ")
  2036.         (message-unique-id)))
  2037.      (default-type (or (car gnus-group-web-type-history)
  2038.                (symbol-name (caar nnweb-type-definition))))
  2039.      (type
  2040.       (gnus-string-or
  2041.        (completing-read
  2042.         (format "Search engine type (default %s): " default-type)
  2043.         (mapcar (lambda (elem) (list (symbol-name (car elem))))
  2044.             nnweb-type-definition)
  2045.         nil t nil 'gnus-group-web-type-history)
  2046.        default-type))
  2047.      (search
  2048.       (read-string
  2049.        "Search string: "
  2050.        (cons (or (car gnus-group-web-search-history) "") 0)
  2051.        'gnus-group-web-search-history))
  2052.      (method
  2053.       `(nnweb ,group (nnweb-search ,search)
  2054.           (nnweb-type ,(intern type))
  2055.           (nnweb-ephemeral-p t))))
  2056.     (if solid
  2057.     (gnus-group-make-group group "nnweb" "" `(,(intern type) ,search))
  2058.       (gnus-group-read-ephemeral-group
  2059.        group method t
  2060.        (cons (current-buffer)
  2061.          (if (eq major-mode 'gnus-summary-mode) 'summary 'group))))))
  2062.  
  2063. (defun gnus-group-make-archive-group (&optional all)
  2064.   "Create the (ding) Gnus archive group of the most recent articles.
  2065. Given a prefix, create a full group."
  2066.   (interactive "P")
  2067.   (let ((group (gnus-group-prefixed-name
  2068.         (if all "ding.archives" "ding.recent") '(nndir ""))))
  2069.     (when (gnus-gethash group gnus-newsrc-hashtb)
  2070.       (error "Archive group already exists"))
  2071.     (gnus-group-make-group
  2072.      (gnus-group-real-name group)
  2073.      (list 'nndir (if all "hpc" "edu")
  2074.        (list 'nndir-directory
  2075.          (if all gnus-group-archive-directory
  2076.            gnus-group-recent-archive-directory))))
  2077.     (gnus-group-add-parameter group (cons 'to-address "ding@gnus.org"))))
  2078.  
  2079. (defun gnus-group-make-directory-group (dir)
  2080.   "Create an nndir group.
  2081. The user will be prompted for a directory.  The contents of this
  2082. directory will be used as a newsgroup.    The directory should contain
  2083. mail messages or news articles in files that have numeric names."
  2084.   (interactive
  2085.    (list (read-file-name "Create group from directory: ")))
  2086.   (unless (file-exists-p dir)
  2087.     (error "No such directory"))
  2088.   (unless (file-directory-p dir)
  2089.     (error "Not a directory"))
  2090.   (let ((ext "")
  2091.     (i 0)
  2092.     group)
  2093.     (while (or (not group) (gnus-gethash group gnus-newsrc-hashtb))
  2094.       (setq group
  2095.         (gnus-group-prefixed-name
  2096.          (concat (file-name-as-directory (directory-file-name dir))
  2097.              ext)
  2098.          '(nndir "")))
  2099.       (setq ext (format "<%d>" (setq i (1+ i)))))
  2100.     (gnus-group-make-group
  2101.      (gnus-group-real-name group)
  2102.      (list 'nndir (gnus-group-real-name group) (list 'nndir-directory dir)))))
  2103.  
  2104. (defun gnus-group-make-kiboze-group (group address scores)
  2105.   "Create an nnkiboze group.
  2106. The user will be prompted for a name, a regexp to match groups, and
  2107. score file entries for articles to include in the group."
  2108.   (interactive
  2109.    (list
  2110.     (read-string "nnkiboze group name: ")
  2111.     (read-string "Source groups (regexp): ")
  2112.     (let ((headers (mapcar (lambda (group) (list group))
  2113.                '("subject" "from" "number" "date" "message-id"
  2114.                  "references" "chars" "lines" "xref"
  2115.                  "followup" "all" "body" "head")))
  2116.       scores header regexp regexps)
  2117.       (while (not (equal "" (setq header (completing-read
  2118.                       "Match on header: " headers nil t))))
  2119.     (setq regexps nil)
  2120.     (while (not (equal "" (setq regexp (read-string
  2121.                         (format "Match on %s (string): "
  2122.                             header)))))
  2123.       (push (list regexp nil nil 'r) regexps))
  2124.     (push (cons header regexps) scores))
  2125.       scores)))
  2126.   (gnus-group-make-group group "nnkiboze" address)
  2127.   (nnheader-temp-write (gnus-score-file-name (concat "nnkiboze:" group))
  2128.     (let (emacs-lisp-mode-hook)
  2129.       (pp scores (current-buffer)))))
  2130.  
  2131. (defun gnus-group-add-to-virtual (n vgroup)
  2132.   "Add the current group to a virtual group."
  2133.   (interactive
  2134.    (list current-prefix-arg
  2135.      (completing-read "Add to virtual group: " gnus-newsrc-hashtb nil t
  2136.               "nnvirtual:")))
  2137.   (unless (eq (car (gnus-find-method-for-group vgroup)) 'nnvirtual)
  2138.     (error "%s is not an nnvirtual group" vgroup))
  2139.   (gnus-close-group vgroup)
  2140.   (let* ((groups (gnus-group-process-prefix n))
  2141.      (method (gnus-info-method (gnus-get-info vgroup))))
  2142.     (setcar (cdr method)
  2143.         (concat
  2144.          (nth 1 method) "\\|"
  2145.          (mapconcat
  2146.           (lambda (s)
  2147.         (gnus-group-remove-mark s)
  2148.         (concat "\\(^" (regexp-quote s) "$\\)"))
  2149.           groups "\\|"))))
  2150.   (gnus-group-position-point))
  2151.  
  2152. (defun gnus-group-make-empty-virtual (group)
  2153.   "Create a new, fresh, empty virtual group."
  2154.   (interactive "sCreate new, empty virtual group: ")
  2155.   (let* ((method (list 'nnvirtual "^$"))
  2156.      (pgroup (gnus-group-prefixed-name group method)))
  2157.     ;; Check whether it exists already.
  2158.     (when (gnus-gethash pgroup gnus-newsrc-hashtb)
  2159.       (error "Group %s already exists" pgroup))
  2160.     ;; Subscribe the new group after the group on the current line.
  2161.     (gnus-subscribe-group pgroup (gnus-group-group-name) method)
  2162.     (gnus-group-update-group pgroup)
  2163.     (forward-line -1)
  2164.     (gnus-group-position-point)))
  2165.  
  2166. (defun gnus-group-enter-directory (dir)
  2167.   "Enter an ephemeral nneething group."
  2168.   (interactive "DDirectory to read: ")
  2169.   (let* ((method (list 'nneething dir '(nneething-read-only t)))
  2170.      (leaf (gnus-group-prefixed-name
  2171.         (file-name-nondirectory (directory-file-name dir))
  2172.         method))
  2173.      (name (gnus-generate-new-group-name leaf)))
  2174.     (unless (gnus-group-read-ephemeral-group
  2175.          name method t
  2176.          (cons (current-buffer)
  2177.            (if (eq major-mode 'gnus-summary-mode)
  2178.                'summary 'group)))
  2179.       (error "Couldn't enter %s" dir))))
  2180.  
  2181. ;; Group sorting commands
  2182. ;; Suggested by Joe Hildebrand <hildjj@idaho.fuentez.com>.
  2183.  
  2184. (defun gnus-group-sort-groups (func &optional reverse)
  2185.   "Sort the group buffer according to FUNC.
  2186. When used interactively, the sorting function used will be
  2187. determined by the `gnus-group-sort-function' variable.
  2188. If REVERSE (the prefix), reverse the sorting order."
  2189.   (interactive (list gnus-group-sort-function current-prefix-arg))
  2190.   (funcall gnus-group-sort-alist-function
  2191.        (gnus-make-sort-function func) reverse)
  2192.   (gnus-group-list-groups)
  2193.   (gnus-dribble-touch))
  2194.  
  2195. (defun gnus-group-sort-flat (func reverse)
  2196.   ;; We peel off the dummy group from the alist.
  2197.   (when func
  2198.     (when (equal (gnus-info-group (car gnus-newsrc-alist)) "dummy.group")
  2199.       (pop gnus-newsrc-alist))
  2200.     ;; Do the sorting.
  2201.     (setq gnus-newsrc-alist
  2202.       (sort gnus-newsrc-alist func))
  2203.     (when reverse
  2204.       (setq gnus-newsrc-alist (nreverse gnus-newsrc-alist)))
  2205.     ;; Regenerate the hash table.
  2206.     (gnus-make-hashtable-from-newsrc-alist)))
  2207.  
  2208. (defun gnus-group-sort-groups-by-alphabet (&optional reverse)
  2209.   "Sort the group buffer alphabetically by group name.
  2210. If REVERSE, sort in reverse order."
  2211.   (interactive "P")
  2212.   (gnus-group-sort-groups 'gnus-group-sort-by-alphabet reverse))
  2213.  
  2214. (defun gnus-group-sort-groups-by-unread (&optional reverse)
  2215.   "Sort the group buffer by number of unread articles.
  2216. If REVERSE, sort in reverse order."
  2217.   (interactive "P")
  2218.   (gnus-group-sort-groups 'gnus-group-sort-by-unread reverse))
  2219.  
  2220. (defun gnus-group-sort-groups-by-level (&optional reverse)
  2221.   "Sort the group buffer by group level.
  2222. If REVERSE, sort in reverse order."
  2223.   (interactive "P")
  2224.   (gnus-group-sort-groups 'gnus-group-sort-by-level reverse))
  2225.  
  2226. (defun gnus-group-sort-groups-by-score (&optional reverse)
  2227.   "Sort the group buffer by group score.
  2228. If REVERSE, sort in reverse order."
  2229.   (interactive "P")
  2230.   (gnus-group-sort-groups 'gnus-group-sort-by-score reverse))
  2231.  
  2232. (defun gnus-group-sort-groups-by-rank (&optional reverse)
  2233.   "Sort the group buffer by group rank.
  2234. If REVERSE, sort in reverse order."
  2235.   (interactive "P")
  2236.   (gnus-group-sort-groups 'gnus-group-sort-by-rank reverse))
  2237.  
  2238. (defun gnus-group-sort-groups-by-method (&optional reverse)
  2239.   "Sort the group buffer alphabetically by backend name.
  2240. If REVERSE, sort in reverse order."
  2241.   (interactive "P")
  2242.   (gnus-group-sort-groups 'gnus-group-sort-by-method reverse))
  2243.  
  2244. ;;; Selected group sorting.
  2245.  
  2246. (defun gnus-group-sort-selected-groups (n func &optional reverse)
  2247.   "Sort the process/prefixed groups."
  2248.   (interactive (list current-prefix-arg gnus-group-sort-function))
  2249.   (let ((groups (gnus-group-process-prefix n)))
  2250.     (funcall gnus-group-sort-selected-function
  2251.          groups (gnus-make-sort-function func) reverse)
  2252.     (gnus-group-list-groups)))
  2253.  
  2254. (defun gnus-group-sort-selected-flat (groups func reverse)
  2255.   (let (entries infos)
  2256.     ;; First find all the group entries for these groups.
  2257.     (while groups
  2258.       (push (nthcdr 2 (gnus-gethash (pop groups) gnus-newsrc-hashtb))
  2259.         entries))
  2260.     ;; Then sort the infos.
  2261.     (setq infos
  2262.       (sort
  2263.        (mapcar
  2264.         (lambda (entry) (car entry))
  2265.         (setq entries (nreverse entries)))
  2266.        func))
  2267.     (when reverse
  2268.       (setq infos (nreverse infos)))
  2269.     ;; Go through all the infos and replace the old entries
  2270.     ;; with the new infos.
  2271.     (while infos
  2272.       (setcar entries (pop infos))
  2273.       (pop entries))
  2274.     ;; Update the hashtable.
  2275.     (gnus-make-hashtable-from-newsrc-alist)))
  2276.  
  2277. (defun gnus-group-sort-selected-groups-by-alphabet (&optional reverse)
  2278.   "Sort the group buffer alphabetically by group name.
  2279. If REVERSE, sort in reverse order."
  2280.   (interactive "P")
  2281.   (gnus-group-sort-selected-groups 'gnus-group-sort-by-alphabet reverse))
  2282.  
  2283. (defun gnus-group-sort-selected-groups-by-unread (&optional reverse)
  2284.   "Sort the group buffer by number of unread articles.
  2285. If REVERSE, sort in reverse order."
  2286.   (interactive "P")
  2287.   (gnus-group-sort-selected-groups 'gnus-group-sort-by-unread reverse))
  2288.  
  2289. (defun gnus-group-sort-selected-groups-by-level (&optional reverse)
  2290.   "Sort the group buffer by group level.
  2291. If REVERSE, sort in reverse order."
  2292.   (interactive "P")
  2293.   (gnus-group-sort-selected-groups 'gnus-group-sort-by-level reverse))
  2294.  
  2295. (defun gnus-group-sort-selected-groups-by-score (&optional reverse)
  2296.   "Sort the group buffer by group score.
  2297. If REVERSE, sort in reverse order."
  2298.   (interactive "P")
  2299.   (gnus-group-sort-selected-groups 'gnus-group-sort-by-score reverse))
  2300.  
  2301. (defun gnus-group-sort-selected-groups-by-rank (&optional reverse)
  2302.   "Sort the group buffer by group rank.
  2303. If REVERSE, sort in reverse order."
  2304.   (interactive "P")
  2305.   (gnus-group-sort-selected-groups 'gnus-group-sort-by-rank reverse))
  2306.  
  2307. (defun gnus-group-sort-selected-groups-by-method (&optional reverse)
  2308.   "Sort the group buffer alphabetically by backend name.
  2309. If REVERSE, sort in reverse order."
  2310.   (interactive "P")
  2311.   (gnus-group-sort-selected-groups 'gnus-group-sort-by-method reverse))
  2312.  
  2313. ;;; Sorting predicates.
  2314.  
  2315. (defun gnus-group-sort-by-alphabet (info1 info2)
  2316.   "Sort alphabetically."
  2317.   (string< (gnus-info-group info1) (gnus-info-group info2)))
  2318.  
  2319. (defun gnus-group-sort-by-real-name (info1 info2)
  2320.   "Sort alphabetically on real (unprefixed) names."
  2321.   (string< (gnus-group-real-name (gnus-info-group info1))
  2322.        (gnus-group-real-name (gnus-info-group info2))))
  2323.  
  2324. (defun gnus-group-sort-by-unread (info1 info2)
  2325.   "Sort by number of unread articles."
  2326.   (let ((n1 (car (gnus-gethash (gnus-info-group info1) gnus-newsrc-hashtb)))
  2327.     (n2 (car (gnus-gethash (gnus-info-group info2) gnus-newsrc-hashtb))))
  2328.     (< (or (and (numberp n1) n1) 0)
  2329.        (or (and (numberp n2) n2) 0))))
  2330.  
  2331. (defun gnus-group-sort-by-level (info1 info2)
  2332.   "Sort by level."
  2333.   (< (gnus-info-level info1) (gnus-info-level info2)))
  2334.  
  2335. (defun gnus-group-sort-by-method (info1 info2)
  2336.   "Sort alphabetically by backend name."
  2337.   (string< (symbol-name (car (gnus-find-method-for-group
  2338.                   (gnus-info-group info1) info1)))
  2339.        (symbol-name (car (gnus-find-method-for-group
  2340.                   (gnus-info-group info2) info2)))))
  2341.  
  2342. (defun gnus-group-sort-by-score (info1 info2)
  2343.   "Sort by group score."
  2344.   (< (gnus-info-score info1) (gnus-info-score info2)))
  2345.  
  2346. (defun gnus-group-sort-by-rank (info1 info2)
  2347.   "Sort by level and score."
  2348.   (let ((level1 (gnus-info-level info1))
  2349.     (level2 (gnus-info-level info2)))
  2350.     (or (< level1 level2)
  2351.     (and (= level1 level2)
  2352.          (> (gnus-info-score info1) (gnus-info-score info2))))))
  2353.  
  2354. ;;; Clearing data
  2355.  
  2356. (defun gnus-group-clear-data (&optional arg)
  2357.   "Clear all marks and read ranges from the current group."
  2358.   (interactive "P")
  2359.   (gnus-group-iterate arg
  2360.     (lambda (group)
  2361.       (let (info)
  2362.     (gnus-info-clear-data (setq info (gnus-get-info group)))
  2363.     (gnus-get-unread-articles-in-group info (gnus-active group) t)
  2364.     (when (gnus-group-goto-group group)
  2365.       (gnus-group-update-group-line))))))
  2366.  
  2367. (defun gnus-group-clear-data-on-native-groups ()
  2368.   "Clear all marks and read ranges from all native groups."
  2369.   (interactive)
  2370.   (when (gnus-yes-or-no-p "Really clear all data from almost all groups? ")
  2371.     (let ((alist (cdr gnus-newsrc-alist))
  2372.       info)
  2373.       (while (setq info (pop alist))
  2374.     (when (gnus-group-native-p (gnus-info-group info))
  2375.       (gnus-info-clear-data info)))
  2376.       (gnus-get-unread-articles)
  2377.       (gnus-dribble-enter "")
  2378.       (when (gnus-y-or-n-p
  2379.          "Move the cache away to avoid problems in the future? ")
  2380.     (call-interactively 'gnus-cache-move-cache)))))
  2381.  
  2382. (defun gnus-info-clear-data (info)
  2383.   "Clear all marks and read ranges from INFO."
  2384.   (let ((group (gnus-info-group info)))
  2385.     (gnus-undo-register
  2386.       `(progn
  2387.      (gnus-info-set-marks ',info ',(gnus-info-marks info) t)
  2388.      (gnus-info-set-read ',info ',(gnus-info-read info))
  2389.      (when (gnus-group-goto-group ,group)
  2390.        (gnus-group-update-group-line))))
  2391.     (gnus-info-set-read info nil)
  2392.     (when (gnus-info-marks info)
  2393.       (gnus-info-set-marks info nil))))
  2394.  
  2395. ;; Group catching up.
  2396.  
  2397. (defun gnus-group-catchup-current (&optional n all)
  2398.   "Mark all articles not marked as unread in current newsgroup as read.
  2399. If prefix argument N is numeric, the ARG next newsgroups will be
  2400. caught up.  If ALL is non-nil, marked articles will also be marked as
  2401. read.  Cross references (Xref: header) of articles are ignored.
  2402. The difference between N and actual number of newsgroups that were
  2403. caught up is returned."
  2404.   (interactive "P")
  2405.   (unless (gnus-group-group-name)
  2406.     (error "No group on the current line"))
  2407.   (let ((groups (gnus-group-process-prefix n))
  2408.     (ret 0))
  2409.     (if (not
  2410.      (or (not gnus-interactive-catchup) ;Without confirmation?
  2411.          gnus-expert-user
  2412.          (gnus-y-or-n-p
  2413.           (format
  2414.            (if all
  2415.            "Do you really want to mark all articles in %s as read? "
  2416.          "Mark all unread articles in %s as read? ")
  2417.            (if (= (length groups) 1)
  2418.            (car groups)
  2419.          (format "these %d groups" (length groups)))))))
  2420.     n
  2421.       (while groups
  2422.     ;; Virtual groups have to be given special treatment.
  2423.     (let ((method (gnus-find-method-for-group (car groups))))
  2424.       (when (eq 'nnvirtual (car method))
  2425.         (nnvirtual-catchup-group
  2426.          (gnus-group-real-name (car groups)) (nth 1 method) all)))
  2427.     (gnus-group-remove-mark (car groups))
  2428.     (if (>= (gnus-group-group-level) gnus-level-zombie)
  2429.         (gnus-message 2 "Dead groups can't be caught up")
  2430.       (if (prog1
  2431.           (gnus-group-goto-group (car groups))
  2432.         (gnus-group-catchup (car groups) all))
  2433.           (gnus-group-update-group-line)
  2434.         (setq ret (1+ ret))))
  2435.     (setq groups (cdr groups)))
  2436.       (gnus-group-next-unread-group 1)
  2437.       ret)))
  2438.  
  2439. (defun gnus-group-catchup-current-all (&optional n)
  2440.   "Mark all articles in current newsgroup as read.
  2441. Cross references (Xref: header) of articles are ignored."
  2442.   (interactive "P")
  2443.   (gnus-group-catchup-current n 'all))
  2444.  
  2445. (defun gnus-group-catchup (group &optional all)
  2446.   "Mark all articles in GROUP as read.
  2447. If ALL is non-nil, all articles are marked as read.
  2448. The return value is the number of articles that were marked as read,
  2449. or nil if no action could be taken."
  2450.   (let* ((entry (gnus-gethash group gnus-newsrc-hashtb))
  2451.      (num (car entry)))
  2452.     ;; Do the updating only if the newsgroup isn't killed.
  2453.     (if (not (numberp (car entry)))
  2454.     (gnus-message 1 "Can't catch up %s; non-active group" group)
  2455.       ;; Do auto-expirable marks if that's required.
  2456.       (when (gnus-group-auto-expirable-p group)
  2457.     (gnus-add-marked-articles
  2458.      group 'expire (gnus-list-of-unread-articles group))
  2459.     (when all
  2460.       (let ((marks (nth 3 (nth 2 entry))))
  2461.         (gnus-add-marked-articles
  2462.          group 'expire (gnus-uncompress-range (cdr (assq 'tick marks))))
  2463.         (gnus-add-marked-articles
  2464.          group 'expire (gnus-uncompress-range (cdr (assq 'tick marks)))))))
  2465.       (when entry
  2466.     (gnus-update-read-articles group nil)
  2467.     ;; Also nix out the lists of marks and dormants.
  2468.     (when all
  2469.       (gnus-add-marked-articles group 'tick nil nil 'force)
  2470.       (gnus-add-marked-articles group 'dormant nil nil 'force))
  2471.     (let ((gnus-newsgroup-name group))
  2472.       (run-hooks 'gnus-group-catchup-group-hook))
  2473.     num))))
  2474.  
  2475. (defun gnus-group-expire-articles (&optional n)
  2476.   "Expire all expirable articles in the current newsgroup."
  2477.   (interactive "P")
  2478.   (let ((groups (gnus-group-process-prefix n))
  2479.     group)
  2480.     (unless groups
  2481.       (error "No groups to expire"))
  2482.     (while (setq group (pop groups))
  2483.       (gnus-group-remove-mark group)
  2484.       (when (gnus-check-backend-function 'request-expire-articles group)
  2485.     (gnus-message 6 "Expiring articles in %s..." group)
  2486.     (let* ((info (gnus-get-info group))
  2487.            (expirable (if (gnus-group-total-expirable-p group)
  2488.                   (cons nil (gnus-list-of-read-articles group))
  2489.                 (assq 'expire (gnus-info-marks info))))
  2490.            (expiry-wait (gnus-group-find-parameter group 'expiry-wait)))
  2491.       (when expirable
  2492.         (setcdr
  2493.          expirable
  2494.          (gnus-compress-sequence
  2495.           (if expiry-wait
  2496.           ;; We set the expiry variables to the group
  2497.           ;; parameter.
  2498.           (let ((nnmail-expiry-wait-function nil)
  2499.             (nnmail-expiry-wait expiry-wait))
  2500.             (gnus-request-expire-articles
  2501.              (gnus-uncompress-sequence (cdr expirable)) group))
  2502.         ;; Just expire using the normal expiry values.
  2503.         (gnus-request-expire-articles
  2504.          (gnus-uncompress-sequence (cdr expirable)) group))))
  2505.         (gnus-close-group group))
  2506.       (gnus-message 6 "Expiring articles in %s...done" group)))
  2507.       (gnus-dribble-touch)
  2508.       (gnus-group-position-point))))
  2509.  
  2510. (defun gnus-group-expire-all-groups ()
  2511.   "Expire all expirable articles in all newsgroups."
  2512.   (interactive)
  2513.   (save-excursion
  2514.     (gnus-message 5 "Expiring...")
  2515.     (let ((gnus-group-marked (mapcar (lambda (info) (gnus-info-group info))
  2516.                      (cdr gnus-newsrc-alist))))
  2517.       (gnus-group-expire-articles nil)))
  2518.   (gnus-group-position-point)
  2519.   (gnus-message 5 "Expiring...done"))
  2520.  
  2521. (defun gnus-group-set-current-level (n level)
  2522.   "Set the level of the next N groups to LEVEL."
  2523.   (interactive
  2524.    (list
  2525.     current-prefix-arg
  2526.     (string-to-int
  2527.      (let ((s (read-string
  2528.            (format "Level (default %s): "
  2529.                (or (gnus-group-group-level)
  2530.                gnus-level-default-subscribed)))))
  2531.        (if (string-match "^\\s-*$" s)
  2532.        (int-to-string (or (gnus-group-group-level)
  2533.                   gnus-level-default-subscribed))
  2534.      s)))))
  2535.   (unless (and (>= level 1) (<= level gnus-level-killed))
  2536.     (error "Illegal level: %d" level))
  2537.   (let ((groups (gnus-group-process-prefix n))
  2538.     group)
  2539.     (while (setq group (pop groups))
  2540.       (gnus-group-remove-mark group)
  2541.       (gnus-message 6 "Changed level of %s from %d to %d"
  2542.             group (or (gnus-group-group-level) gnus-level-killed)
  2543.             level)
  2544.       (gnus-group-change-level
  2545.        group level (or (gnus-group-group-level) gnus-level-killed))
  2546.       (gnus-group-update-group-line)))
  2547.   (gnus-group-position-point))
  2548.  
  2549. (defun gnus-group-unsubscribe (&optional n)
  2550.   "Unsubscribe the current group."
  2551.   (interactive "P")
  2552.   (gnus-group-unsubscribe-current-group n 'unsubscribe))
  2553.  
  2554. (defun gnus-group-subscribe (&optional n)
  2555.   "Subscribe the current group."
  2556.   (interactive "P")
  2557.   (gnus-group-unsubscribe-current-group n 'subscribe))
  2558.  
  2559. (defun gnus-group-unsubscribe-current-group (&optional n do-sub)
  2560.   "Toggle subscription of the current group.
  2561. If given numerical prefix, toggle the N next groups."
  2562.   (interactive "P")
  2563.   (let ((groups (gnus-group-process-prefix n))
  2564.     group)
  2565.     (while groups
  2566.       (setq group (car groups)
  2567.         groups (cdr groups))
  2568.       (gnus-group-remove-mark group)
  2569.       (gnus-group-unsubscribe-group
  2570.        group
  2571.        (cond
  2572.     ((eq do-sub 'unsubscribe)
  2573.      gnus-level-default-unsubscribed)
  2574.     ((eq do-sub 'subscribe)
  2575.      gnus-level-default-subscribed)
  2576.     ((<= (gnus-group-group-level) gnus-level-subscribed)
  2577.      gnus-level-default-unsubscribed)
  2578.     (t
  2579.      gnus-level-default-subscribed))
  2580.        t)
  2581.       (gnus-group-update-group-line))
  2582.     (gnus-group-next-group 1)))
  2583.  
  2584. (defun gnus-group-unsubscribe-group (group &optional level silent)
  2585.   "Toggle subscription to GROUP.
  2586. Killed newsgroups are subscribed.  If SILENT, don't try to update the
  2587. group line."
  2588.   (interactive
  2589.    (list (completing-read
  2590.       "Group: " gnus-active-hashtb nil
  2591.       (gnus-read-active-file-p)
  2592.       nil
  2593.       'gnus-group-history)))
  2594.   (let ((newsrc (gnus-gethash group gnus-newsrc-hashtb)))
  2595.     (cond
  2596.      ((string-match "^[ \t]$" group)
  2597.       (error "Empty group name"))
  2598.      (newsrc
  2599.       ;; Toggle subscription flag.
  2600.       (gnus-group-change-level
  2601.        newsrc (if level level (if (<= (gnus-info-level (nth 2 newsrc))
  2602.                       gnus-level-subscribed)
  2603.                   (1+ gnus-level-subscribed)
  2604.                 gnus-level-default-subscribed)))
  2605.       (unless silent
  2606.     (gnus-group-update-group group)))
  2607.      ((and (stringp group)
  2608.        (or (not (gnus-read-active-file-p))
  2609.            (gnus-active group)))
  2610.       ;; Add new newsgroup.
  2611.       (gnus-group-change-level
  2612.        group
  2613.        (if level level gnus-level-default-subscribed)
  2614.        (or (and (member group gnus-zombie-list)
  2615.         gnus-level-zombie)
  2616.        gnus-level-killed)
  2617.        (when (gnus-group-group-name)
  2618.      (gnus-gethash (gnus-group-group-name) gnus-newsrc-hashtb)))
  2619.       (unless silent
  2620.     (gnus-group-update-group group)))
  2621.      (t (error "No such newsgroup: %s" group)))
  2622.     (gnus-group-position-point)))
  2623.  
  2624. (defun gnus-group-transpose-groups (n)
  2625.   "Move the current newsgroup up N places.
  2626. If given a negative prefix, move down instead.    The difference between
  2627. N and the number of steps taken is returned."
  2628.   (interactive "p")
  2629.   (unless (gnus-group-group-name)
  2630.     (error "No group on current line"))
  2631.   (gnus-group-kill-group 1)
  2632.   (prog1
  2633.       (forward-line (- n))
  2634.     (gnus-group-yank-group)
  2635.     (gnus-group-position-point)))
  2636.  
  2637. (defun gnus-group-kill-all-zombies ()
  2638.   "Kill all zombie newsgroups."
  2639.   (interactive)
  2640.   (setq gnus-killed-list (nconc gnus-zombie-list gnus-killed-list))
  2641.   (setq gnus-zombie-list nil)
  2642.   (gnus-dribble-touch)
  2643.   (gnus-group-list-groups))
  2644.  
  2645. (defun gnus-group-kill-region (begin end)
  2646.   "Kill newsgroups in current region (excluding current point).
  2647. The killed newsgroups can be yanked by using \\[gnus-group-yank-group]."
  2648.   (interactive "r")
  2649.   (let ((lines
  2650.      ;; Count lines.
  2651.      (save-excursion
  2652.        (count-lines
  2653.         (progn
  2654.           (goto-char begin)
  2655.           (beginning-of-line)
  2656.           (point))
  2657.         (progn
  2658.           (goto-char end)
  2659.           (beginning-of-line)
  2660.           (point))))))
  2661.     (goto-char begin)
  2662.     (beginning-of-line)            ;Important when LINES < 1
  2663.     (gnus-group-kill-group lines)))
  2664.  
  2665. (defun gnus-group-kill-group (&optional n discard)
  2666.   "Kill the next N groups.
  2667. The killed newsgroups can be yanked by using \\[gnus-group-yank-group].
  2668. However, only groups that were alive can be yanked; already killed
  2669. groups or zombie groups can't be yanked.
  2670. The return value is the name of the group that was killed, or a list
  2671. of groups killed."
  2672.   (interactive "P")
  2673.   (let ((buffer-read-only nil)
  2674.     (groups (gnus-group-process-prefix n))
  2675.     group entry level out)
  2676.     (if (< (length groups) 10)
  2677.     ;; This is faster when there are few groups.
  2678.     (while groups
  2679.       (push (setq group (pop groups)) out)
  2680.       (gnus-group-remove-mark group)
  2681.       (setq level (gnus-group-group-level))
  2682.       (gnus-delete-line)
  2683.       (when (and (not discard)
  2684.              (setq entry (gnus-gethash group gnus-newsrc-hashtb)))
  2685.         (gnus-undo-register
  2686.           `(progn
  2687.          (gnus-group-goto-group ,(gnus-group-group-name))
  2688.          (gnus-group-yank-group)))
  2689.         (push (cons (car entry) (nth 2 entry))
  2690.           gnus-list-of-killed-groups))
  2691.       (gnus-group-change-level
  2692.        (if entry entry group) gnus-level-killed (if entry nil level)))
  2693.       ;; If there are lots and lots of groups to be killed, we use
  2694.       ;; this thing instead.
  2695.       (let (entry)
  2696.     (setq groups (nreverse groups))
  2697.     (while groups
  2698.       (gnus-group-remove-mark (setq group (pop groups)))
  2699.       (gnus-delete-line)
  2700.       (push group gnus-killed-list)
  2701.       (setq gnus-newsrc-alist
  2702.         (delq (assoc group gnus-newsrc-alist)
  2703.               gnus-newsrc-alist))
  2704.       (when gnus-group-change-level-function
  2705.         (funcall gnus-group-change-level-function group 9 3))
  2706.       (cond
  2707.        ((setq entry (gnus-gethash group gnus-newsrc-hashtb))
  2708.         (push (cons (car entry) (nth 2 entry))
  2709.           gnus-list-of-killed-groups)
  2710.         (setcdr (cdr entry) (cdddr entry)))
  2711.        ((member group gnus-zombie-list)
  2712.         (setq gnus-zombie-list (delete group gnus-zombie-list)))))
  2713.     (gnus-make-hashtable-from-newsrc-alist)))
  2714.  
  2715.     (gnus-group-position-point)
  2716.     (if (< (length out) 2) (car out) (nreverse out))))
  2717.  
  2718. (defun gnus-group-yank-group (&optional arg)
  2719.   "Yank the last newsgroups killed with \\[gnus-group-kill-group],
  2720. inserting it before the current newsgroup.  The numeric ARG specifies
  2721. how many newsgroups are to be yanked.  The name of the newsgroup yanked
  2722. is returned, or (if several groups are yanked) a list of yanked groups
  2723. is returned."
  2724.   (interactive "p")
  2725.   (setq arg (or arg 1))
  2726.   (let (info group prev out)
  2727.     (while (>= (decf arg) 0)
  2728.       (when (not (setq info (pop gnus-list-of-killed-groups)))
  2729.     (error "No more newsgroups to yank"))
  2730.       (push (setq group (nth 1 info)) out)
  2731.       ;; Find which newsgroup to insert this one before - search
  2732.       ;; backward until something suitable is found.  If there are no
  2733.       ;; other newsgroups in this buffer, just make this newsgroup the
  2734.       ;; first newsgroup.
  2735.       (setq prev (gnus-group-group-name))
  2736.       (gnus-group-change-level
  2737.        info (gnus-info-level (cdr info)) gnus-level-killed
  2738.        (and prev (gnus-gethash prev gnus-newsrc-hashtb))
  2739.        t)
  2740.       (gnus-group-insert-group-line-info group)
  2741.       (gnus-undo-register
  2742.     `(when (gnus-group-goto-group ,group)
  2743.        (gnus-group-kill-group 1))))
  2744.     (forward-line -1)
  2745.     (gnus-group-position-point)
  2746.     (if (< (length out) 2) (car out) (nreverse out))))
  2747.  
  2748. (defun gnus-group-kill-level (level)
  2749.   "Kill all groups that is on a certain LEVEL."
  2750.   (interactive "nKill all groups on level: ")
  2751.   (cond
  2752.    ((= level gnus-level-zombie)
  2753.     (setq gnus-killed-list
  2754.       (nconc gnus-zombie-list gnus-killed-list))
  2755.     (setq gnus-zombie-list nil))
  2756.    ((and (< level gnus-level-zombie)
  2757.      (> level 0)
  2758.      (or gnus-expert-user
  2759.          (gnus-yes-or-no-p
  2760.           (format
  2761.            "Do you really want to kill all groups on level %d? "
  2762.            level))))
  2763.     (let* ((prev gnus-newsrc-alist)
  2764.        (alist (cdr prev)))
  2765.       (while alist
  2766.     (if (= (gnus-info-level (car alist)) level)
  2767.         (progn
  2768.           (push (gnus-info-group (car alist)) gnus-killed-list)
  2769.           (setcdr prev (cdr alist)))
  2770.       (setq prev alist))
  2771.     (setq alist (cdr alist)))
  2772.       (gnus-make-hashtable-from-newsrc-alist)
  2773.       (gnus-group-list-groups)))
  2774.    (t
  2775.     (error "Can't kill; illegal level: %d" level))))
  2776.  
  2777. (defun gnus-group-list-all-groups (&optional arg)
  2778.   "List all newsgroups with level ARG or lower.
  2779. Default is gnus-level-unsubscribed, which lists all subscribed and most
  2780. unsubscribed groups."
  2781.   (interactive "P")
  2782.   (gnus-group-list-groups (or arg gnus-level-unsubscribed) t))
  2783.  
  2784. ;; Redefine this to list ALL killed groups if prefix arg used.
  2785. ;; Rewritten by engstrom@src.honeywell.com (Eric Engstrom).
  2786. (defun gnus-group-list-killed (&optional arg)
  2787.   "List all killed newsgroups in the group buffer.
  2788. If ARG is non-nil, list ALL killed groups known to Gnus.  This may
  2789. entail asking the server for the groups."
  2790.   (interactive "P")
  2791.   ;; Find all possible killed newsgroups if arg.
  2792.   (when arg
  2793.     (gnus-get-killed-groups))
  2794.   (if (not gnus-killed-list)
  2795.       (gnus-message 6 "No killed groups")
  2796.     (let (gnus-group-list-mode)
  2797.       (funcall gnus-group-prepare-function
  2798.            gnus-level-killed t gnus-level-killed))
  2799.     (goto-char (point-min)))
  2800.   (gnus-group-position-point))
  2801.  
  2802. (defun gnus-group-list-zombies ()
  2803.   "List all zombie newsgroups in the group buffer."
  2804.   (interactive)
  2805.   (if (not gnus-zombie-list)
  2806.       (gnus-message 6 "No zombie groups")
  2807.     (let (gnus-group-list-mode)
  2808.       (funcall gnus-group-prepare-function
  2809.            gnus-level-zombie t gnus-level-zombie))
  2810.     (goto-char (point-min)))
  2811.   (gnus-group-position-point))
  2812.  
  2813. (defun gnus-group-list-active ()
  2814.   "List all groups that are available from the server(s)."
  2815.   (interactive)
  2816.   ;; First we make sure that we have really read the active file.
  2817.   (unless (gnus-read-active-file-p)
  2818.     (let ((gnus-read-active-file t))
  2819.       (gnus-read-active-file)))
  2820.   ;; Find all groups and sort them.
  2821.   (let ((groups
  2822.      (sort
  2823.       (let (list)
  2824.         (mapatoms
  2825.          (lambda (sym)
  2826.            (and (boundp sym)
  2827.             (symbol-value sym)
  2828.             (push (symbol-name sym) list)))
  2829.          gnus-active-hashtb)
  2830.         list)
  2831.       'string<))
  2832.     (buffer-read-only nil)
  2833.     group)
  2834.     (erase-buffer)
  2835.     (while groups
  2836.       (gnus-add-text-properties
  2837.        (point) (prog1 (1+ (point))
  2838.          (insert "       *: "
  2839.              (setq group (pop groups)) "\n"))
  2840.        (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)
  2841.          'gnus-unread t
  2842.          'gnus-level (inline (gnus-group-level group)))))
  2843.     (goto-char (point-min))))
  2844.  
  2845. (defun gnus-activate-all-groups (level)
  2846.   "Activate absolutely all groups."
  2847.   (interactive (list 7))
  2848.   (let ((gnus-activate-level level)
  2849.     (gnus-activate-foreign-newsgroups level))
  2850.     (gnus-group-get-new-news)))
  2851.  
  2852. (defun gnus-group-get-new-news (&optional arg)
  2853.   "Get newly arrived articles.
  2854. If ARG is a number, it specifies which levels you are interested in
  2855. re-scanning.  If ARG is non-nil and not a number, this will force
  2856. \"hard\" re-reading of the active files from all servers."
  2857.   (interactive "P")
  2858.   (let ((gnus-inhibit-demon t))
  2859.     (run-hooks 'gnus-get-new-news-hook)
  2860.  
  2861.     ;; Read any slave files.
  2862.     (unless gnus-slave
  2863.       (gnus-master-read-slave-newsrc))
  2864.  
  2865.     ;; We might read in new NoCeM messages here.
  2866.     (when (and gnus-use-nocem
  2867.            (null arg))
  2868.       (gnus-nocem-scan-groups))
  2869.     ;; If ARG is not a number, then we read the active file.
  2870.     (when (and arg (not (numberp arg)))
  2871.       (let ((gnus-read-active-file t))
  2872.     (gnus-read-active-file))
  2873.       (setq arg nil)
  2874.  
  2875.       ;; If the user wants it, we scan for new groups.
  2876.       (when (eq gnus-check-new-newsgroups 'always)
  2877.     (gnus-find-new-newsgroups)))
  2878.  
  2879.     (setq arg (gnus-group-default-level arg t))
  2880.     (if (and gnus-read-active-file (not arg))
  2881.     (progn
  2882.       (gnus-read-active-file)
  2883.       (gnus-get-unread-articles arg))
  2884.       (let ((gnus-read-active-file (if arg nil gnus-read-active-file)))
  2885.     (gnus-get-unread-articles arg)))
  2886.     (run-hooks 'gnus-after-getting-new-news-hook)
  2887.     (gnus-group-list-groups (and (numberp arg)
  2888.                  (max (car gnus-group-list-mode) arg)))))
  2889.  
  2890. (defun gnus-group-get-new-news-this-group (&optional n dont-scan)
  2891.   "Check for newly arrived news in the current group (and the N-1 next groups).
  2892. The difference between N and the number of newsgroup checked is returned.
  2893. If N is negative, this group and the N-1 previous groups will be checked."
  2894.   (interactive "P")
  2895.   (let* ((groups (gnus-group-process-prefix n))
  2896.      (ret (if (numberp n) (- n (length groups)) 0))
  2897.      (beg (unless n
  2898.         (point)))
  2899.      group)
  2900.     (while (setq group (pop groups))
  2901.       (gnus-group-remove-mark group)
  2902.       ;; Bypass any previous denials from the server.
  2903.       (gnus-remove-denial (gnus-find-method-for-group group))
  2904.       (if (gnus-activate-group group (if dont-scan nil 'scan))
  2905.       (progn
  2906.         (gnus-get-unread-articles-in-group
  2907.          (gnus-get-info group) (gnus-active group) t)
  2908.         (unless (gnus-virtual-group-p group)
  2909.           (gnus-close-group group))
  2910.         (gnus-group-update-group group))
  2911.     (if (eq (gnus-server-status (gnus-find-method-for-group group))
  2912.         'denied)
  2913.         (gnus-error 3 "Server denied access")
  2914.       (gnus-error 3 "%s error: %s" group (gnus-status-message group)))))
  2915.     (when beg
  2916.       (goto-char beg))
  2917.     (when gnus-goto-next-group-when-activating
  2918.       (gnus-group-next-unread-group 1 t))
  2919.     (gnus-summary-position-point)
  2920.     ret))
  2921.  
  2922. (defun gnus-group-fetch-faq (group &optional faq-dir)
  2923.   "Fetch the FAQ for the current group.
  2924. If given a prefix argument, prompt for the FAQ dir
  2925. to use."
  2926.   (interactive
  2927.    (list
  2928.     (gnus-group-group-name)
  2929.     (when current-prefix-arg
  2930.       (completing-read
  2931.        "Faq dir: " (and (listp gnus-group-faq-directory)
  2932.             (mapcar (lambda (file) (list file))
  2933.                 gnus-group-faq-directory))))))
  2934.   (unless group
  2935.     (error "No group name given"))
  2936.   (let ((dirs (or faq-dir gnus-group-faq-directory))
  2937.     dir found file)
  2938.     (unless (listp dirs)
  2939.       (setq dirs (list dirs)))
  2940.     (while (and (not found)
  2941.         (setq dir (pop dirs)))
  2942.       (setq file (concat (file-name-as-directory dir)
  2943.              (gnus-group-real-name group)))
  2944.       (if (not (file-exists-p file))
  2945.       (gnus-message 1 "No such file: %s" file)
  2946.     (let ((enable-local-variables nil))
  2947.       (find-file file)
  2948.       (setq found t))))))
  2949.  
  2950. (defun gnus-group-describe-group (force &optional group)
  2951.   "Display a description of the current newsgroup."
  2952.   (interactive (list current-prefix-arg (gnus-group-group-name)))
  2953.   (let* ((method (gnus-find-method-for-group group))
  2954.      (mname (gnus-group-prefixed-name "" method))
  2955.      desc)
  2956.     (when (and force
  2957.            gnus-description-hashtb)
  2958.       (gnus-sethash mname nil gnus-description-hashtb))
  2959.     (unless group
  2960.       (error "No group name given"))
  2961.     (when (or (and gnus-description-hashtb
  2962.            ;; We check whether this group's method has been
  2963.            ;; queried for a description file.
  2964.            (gnus-gethash mname gnus-description-hashtb))
  2965.           (setq desc (gnus-group-get-description group))
  2966.           (gnus-read-descriptions-file method))
  2967.       (gnus-message 1
  2968.             (or desc (gnus-gethash group gnus-description-hashtb)
  2969.             "No description available")))))
  2970.  
  2971. ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
  2972. (defun gnus-group-describe-all-groups (&optional force)
  2973.   "Pop up a buffer with descriptions of all newsgroups."
  2974.   (interactive "P")
  2975.   (when force
  2976.     (setq gnus-description-hashtb nil))
  2977.   (when (not (or gnus-description-hashtb
  2978.          (gnus-read-all-descriptions-files)))
  2979.     (error "Couldn't request descriptions file"))
  2980.   (let ((buffer-read-only nil)
  2981.     b)
  2982.     (erase-buffer)
  2983.     (mapatoms
  2984.      (lambda (group)
  2985.        (setq b (point))
  2986.        (insert (format "      *: %-20s %s\n" (symbol-name group)
  2987.                (symbol-value group)))
  2988.        (gnus-add-text-properties
  2989.     b (1+ b) (list 'gnus-group group
  2990.                'gnus-unread t 'gnus-marked nil
  2991.                'gnus-level (1+ gnus-level-subscribed))))
  2992.      gnus-description-hashtb)
  2993.     (goto-char (point-min))
  2994.     (gnus-group-position-point)))
  2995.  
  2996. ;; Suggested by Daniel Quinlan <quinlan@best.com>.
  2997. (defun gnus-group-apropos (regexp &optional search-description)
  2998.   "List all newsgroups that have names that match a regexp."
  2999.   (interactive "sGnus apropos (regexp): ")
  3000.   (let ((prev "")
  3001.     (obuf (current-buffer))
  3002.     groups des)
  3003.     ;; Go through all newsgroups that are known to Gnus.
  3004.     (mapatoms
  3005.      (lambda (group)
  3006.        (and (symbol-name group)
  3007.         (string-match regexp (symbol-name group))
  3008.         (push (symbol-name group) groups)))
  3009.      gnus-active-hashtb)
  3010.     ;; Also go through all descriptions that are known to Gnus.
  3011.     (when search-description
  3012.       (mapatoms
  3013.        (lambda (group)
  3014.      (and (string-match regexp (symbol-value group))
  3015.           (gnus-active (symbol-name group))
  3016.           (push (symbol-name group) groups)))
  3017.        gnus-description-hashtb))
  3018.     (if (not groups)
  3019.     (gnus-message 3 "No groups matched \"%s\"." regexp)
  3020.       ;; Print out all the groups.
  3021.       (save-excursion
  3022.     (pop-to-buffer "*Gnus Help*")
  3023.     (buffer-disable-undo (current-buffer))
  3024.     (erase-buffer)
  3025.     (setq groups (sort groups 'string<))
  3026.     (while groups
  3027.       ;; Groups may be entered twice into the list of groups.
  3028.       (when (not (string= (car groups) prev))
  3029.         (insert (setq prev (car groups)) "\n")
  3030.         (when (and gnus-description-hashtb
  3031.                (setq des (gnus-gethash (car groups)
  3032.                            gnus-description-hashtb)))
  3033.           (insert "  " des "\n")))
  3034.       (setq groups (cdr groups)))
  3035.     (goto-char (point-min))))
  3036.     (pop-to-buffer obuf)))
  3037.  
  3038. (defun gnus-group-description-apropos (regexp)
  3039.   "List all newsgroups that have names or descriptions that match a regexp."
  3040.   (interactive "sGnus description apropos (regexp): ")
  3041.   (when (not (or gnus-description-hashtb
  3042.          (gnus-read-all-descriptions-files)))
  3043.     (error "Couldn't request descriptions file"))
  3044.   (gnus-group-apropos regexp t))
  3045.  
  3046. ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
  3047. (defun gnus-group-list-matching (level regexp &optional all lowest)
  3048.   "List all groups with unread articles that match REGEXP.
  3049. If the prefix LEVEL is non-nil, it should be a number that says which
  3050. level to cut off listing groups.
  3051. If ALL, also list groups with no unread articles.
  3052. If LOWEST, don't list groups with level lower than LOWEST.
  3053.  
  3054. This command may read the active file."
  3055.   (interactive "P\nsList newsgroups matching: ")
  3056.   ;; First make sure active file has been read.
  3057.   (when (and level
  3058.          (> (prefix-numeric-value level) gnus-level-killed))
  3059.     (gnus-get-killed-groups))
  3060.   (gnus-group-prepare-flat
  3061.    (or level gnus-level-subscribed) all (or lowest 1) regexp)
  3062.   (goto-char (point-min))
  3063.   (gnus-group-position-point))
  3064.  
  3065. (defun gnus-group-list-all-matching (level regexp &optional lowest)
  3066.   "List all groups that match REGEXP.
  3067. If the prefix LEVEL is non-nil, it should be a number that says which
  3068. level to cut off listing groups.
  3069. If LOWEST, don't list groups with level lower than LOWEST."
  3070.   (interactive "P\nsList newsgroups matching: ")
  3071.   (when level
  3072.     (setq level (prefix-numeric-value level)))
  3073.   (gnus-group-list-matching (or level gnus-level-killed) regexp t lowest))
  3074.  
  3075. ;; Suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>.
  3076. (defun gnus-group-save-newsrc (&optional force)
  3077.   "Save the Gnus startup files.
  3078. If FORCE, force saving whether it is necessary or not."
  3079.   (interactive "P")
  3080.   (gnus-save-newsrc-file force))
  3081.  
  3082. (defun gnus-group-restart (&optional arg)
  3083.   "Force Gnus to read the .newsrc file."
  3084.   (interactive "P")
  3085.   (when (gnus-yes-or-no-p
  3086.      (format "Are you sure you want to restart Gnus? "))
  3087.     (gnus-save-newsrc-file)
  3088.     (gnus-clear-system)
  3089.     (gnus)))
  3090.  
  3091. (defun gnus-group-read-init-file ()
  3092.   "Read the Gnus elisp init file."
  3093.   (interactive)
  3094.   (gnus-read-init-file)
  3095.   (gnus-message 5 "Read %s" gnus-init-file))
  3096.  
  3097. (defun gnus-group-check-bogus-groups (&optional silent)
  3098.   "Check bogus newsgroups.
  3099. If given a prefix, don't ask for confirmation before removing a bogus
  3100. group."
  3101.   (interactive "P")
  3102.   (gnus-check-bogus-newsgroups (and (not silent) (not gnus-expert-user)))
  3103.   (gnus-group-list-groups))
  3104.  
  3105. (defun gnus-group-find-new-groups (&optional arg)
  3106.   "Search for new groups and add them.
  3107. Each new group will be treated with `gnus-subscribe-newsgroup-method.'
  3108. If ARG (the prefix), use the `ask-server' method to query
  3109. the server for new groups."
  3110.   (interactive "P")
  3111.   (gnus-find-new-newsgroups arg)
  3112.   (gnus-group-list-groups))
  3113.   
  3114. (defun gnus-group-edit-global-kill (&optional article group)
  3115.   "Edit the global kill file.
  3116. If GROUP, edit that local kill file instead."
  3117.   (interactive "P")
  3118.   (setq gnus-current-kill-article article)
  3119.   (gnus-kill-file-edit-file group)
  3120.   (gnus-message
  3121.    6
  3122.    (substitute-command-keys
  3123.     (format "Editing a %s kill file (Type \\[gnus-kill-file-exit] to exit)"
  3124.         (if group "local" "global")))))
  3125.  
  3126. (defun gnus-group-edit-local-kill (article group)
  3127.   "Edit a local kill file."
  3128.   (interactive (list nil (gnus-group-group-name)))
  3129.   (gnus-group-edit-global-kill article group))
  3130.  
  3131. (defun gnus-group-force-update ()
  3132.   "Update `.newsrc' file."
  3133.   (interactive)
  3134.   (gnus-save-newsrc-file))
  3135.  
  3136. (defun gnus-group-suspend ()
  3137.   "Suspend the current Gnus session.
  3138. In fact, cleanup buffers except for group mode buffer.
  3139. The hook gnus-suspend-gnus-hook is called before actually suspending."
  3140.   (interactive)
  3141.   (run-hooks 'gnus-suspend-gnus-hook)
  3142.   ;; Kill Gnus buffers except for group mode buffer.
  3143.   (let* ((group-buf (get-buffer gnus-group-buffer))
  3144.      ;; Do this on a separate list in case the user does a ^G before we finish
  3145.      (gnus-buffer-list
  3146.       (delete group-buf (delete gnus-dribble-buffer
  3147.                     (append gnus-buffer-list nil)))))
  3148.     (while gnus-buffer-list
  3149.       (gnus-kill-buffer (pop gnus-buffer-list)))
  3150.     (gnus-kill-gnus-frames)
  3151.     (when group-buf
  3152.       (setq gnus-buffer-list (list group-buf))
  3153.       (bury-buffer group-buf)
  3154.       (delete-windows-on group-buf t))))
  3155.  
  3156. (defun gnus-group-clear-dribble ()
  3157.   "Clear all information from the dribble buffer."
  3158.   (interactive)
  3159.   (gnus-dribble-clear)
  3160.   (gnus-message 7 "Cleared dribble buffer"))
  3161.  
  3162. (defun gnus-group-exit ()
  3163.   "Quit reading news after updating .newsrc.eld and .newsrc.
  3164. The hook `gnus-exit-gnus-hook' is called before actually exiting."
  3165.   (interactive)
  3166.   (when
  3167.       (or noninteractive        ;For gnus-batch-kill
  3168.       (not gnus-interactive-exit)    ;Without confirmation
  3169.       gnus-expert-user
  3170.       (gnus-y-or-n-p "Are you sure you want to quit reading news? "))
  3171.     (run-hooks 'gnus-exit-gnus-hook)
  3172.     ;; Offer to save data from non-quitted summary buffers.
  3173.     (gnus-offer-save-summaries)
  3174.     ;; Save the newsrc file(s).
  3175.     (gnus-save-newsrc-file)
  3176.     ;; Kill-em-all.
  3177.     (gnus-close-backends)
  3178.     ;; Reset everything.
  3179.     (gnus-clear-system)
  3180.     ;; Allow the user to do things after cleaning up.
  3181.     (run-hooks 'gnus-after-exiting-gnus-hook)))
  3182.  
  3183. (defun gnus-group-quit ()
  3184.   "Quit reading news without updating .newsrc.eld or .newsrc.
  3185. The hook `gnus-exit-gnus-hook' is called before actually exiting."
  3186.   (interactive)
  3187.   (when (or noninteractive        ;For gnus-batch-kill
  3188.         (zerop (buffer-size))
  3189.         (not (gnus-server-opened gnus-select-method))
  3190.         gnus-expert-user
  3191.         (not gnus-current-startup-file)
  3192.         (gnus-yes-or-no-p
  3193.          (format "Quit reading news without saving %s? "
  3194.              (file-name-nondirectory gnus-current-startup-file))))
  3195.     (run-hooks 'gnus-exit-gnus-hook)
  3196.     (gnus-configure-windows 'group t)
  3197.     (gnus-dribble-save)
  3198.     (gnus-close-backends)
  3199.     (gnus-clear-system)
  3200.     (gnus-kill-buffer gnus-group-buffer)
  3201.     ;; Allow the user to do things after cleaning up.
  3202.     (run-hooks 'gnus-after-exiting-gnus-hook)))
  3203.  
  3204. (defun gnus-group-describe-briefly ()
  3205.   "Give a one line description of the group mode commands."
  3206.   (interactive)
  3207.   (gnus-message 7 (substitute-command-keys "\\<gnus-group-mode-map>\\[gnus-group-read-group]:Select  \\[gnus-group-next-unread-group]:Forward  \\[gnus-group-prev-unread-group]:Backward  \\[gnus-group-exit]:Exit  \\[gnus-info-find-node]:Run Info  \\[gnus-group-describe-briefly]:This help")))
  3208.  
  3209. (defun gnus-group-browse-foreign-server (method)
  3210.   "Browse a foreign news server.
  3211. If called interactively, this function will ask for a select method
  3212.  (nntp, nnspool, etc.) and a server address (eg. nntp.some.where).
  3213. If not, METHOD should be a list where the first element is the method
  3214. and the second element is the address."
  3215.   (interactive
  3216.    (list (let ((how (completing-read
  3217.              "Which backend: "
  3218.              (append gnus-valid-select-methods gnus-server-alist)
  3219.              nil t (cons "nntp" 0) 'gnus-method-history)))
  3220.        ;; We either got a backend name or a virtual server name.
  3221.        ;; If the first, we also need an address.
  3222.        (if (assoc how gnus-valid-select-methods)
  3223.            (list (intern how)
  3224.              ;; Suggested by mapjph@bath.ac.uk.
  3225.              (completing-read
  3226.               "Address: "
  3227.               (mapcar (lambda (server) (list server))
  3228.                   gnus-secondary-servers)))
  3229.          ;; We got a server name.
  3230.          how))))
  3231.   (gnus-browse-foreign-server method))
  3232.  
  3233. (defun gnus-group-set-info (info &optional method-only-group part)
  3234.   (let* ((entry (gnus-gethash
  3235.          (or method-only-group (gnus-info-group info))
  3236.          gnus-newsrc-hashtb))
  3237.      (part-info info)
  3238.      (info (if method-only-group (nth 2 entry) info))
  3239.      method)
  3240.     (when method-only-group
  3241.       (unless entry
  3242.     (error "Trying to change non-existent group %s" method-only-group))
  3243.       ;; We have received parts of the actual group info - either the
  3244.       ;; select method or the group parameters.     We first check
  3245.       ;; whether we have to extend the info, and if so, do that.
  3246.       (let ((len (length info))
  3247.         (total (if (eq part 'method) 5 6)))
  3248.     (when (< len total)
  3249.       (setcdr (nthcdr (1- len) info)
  3250.           (make-list (- total len) nil)))
  3251.     ;; Then we enter the new info.
  3252.     (setcar (nthcdr (1- total) info) part-info)))
  3253.     (unless entry
  3254.       ;; This is a new group, so we just create it.
  3255.       (save-excursion
  3256.     (set-buffer gnus-group-buffer)
  3257.     (setq method (gnus-info-method info))
  3258.     (when (gnus-server-equal method "native")
  3259.       (setq method nil))
  3260.     (save-excursion
  3261.       (set-buffer gnus-group-buffer)
  3262.       (if method
  3263.           ;; It's a foreign group...
  3264.           (gnus-group-make-group
  3265.            (gnus-group-real-name (gnus-info-group info))
  3266.            (if (stringp method) method
  3267.          (prin1-to-string (car method)))
  3268.            (and (consp method)
  3269.             (nth 1 (gnus-info-method info))))
  3270.         ;; It's a native group.
  3271.         (gnus-group-make-group (gnus-info-group info))))
  3272.     (gnus-message 6 "Note: New group created")
  3273.     (setq entry
  3274.           (gnus-gethash (gnus-group-prefixed-name
  3275.                  (gnus-group-real-name (gnus-info-group info))
  3276.                  (or (gnus-info-method info) gnus-select-method))
  3277.                 gnus-newsrc-hashtb))))
  3278.     ;; Whether it was a new group or not, we now have the entry, so we
  3279.     ;; can do the update.
  3280.     (if entry
  3281.     (progn
  3282.       (setcar (nthcdr 2 entry) info)
  3283.       (when (and (not (eq (car entry) t))
  3284.              (gnus-active (gnus-info-group info)))
  3285.         (setcar entry (length (gnus-list-of-unread-articles (car info))))))
  3286.       (error "No such group: %s" (gnus-info-group info)))))
  3287.  
  3288. (defun gnus-group-set-method-info (group select-method)
  3289.   (gnus-group-set-info select-method group 'method))
  3290.  
  3291. (defun gnus-group-set-params-info (group params)
  3292.   (gnus-group-set-info params group 'params))
  3293.  
  3294. (defun gnus-add-marked-articles (group type articles &optional info force)
  3295.   ;; Add ARTICLES of TYPE to the info of GROUP.
  3296.   ;; If INFO is non-nil, use that info.     If FORCE is non-nil, don't
  3297.   ;; add, but replace marked articles of TYPE with ARTICLES.
  3298.   (let ((info (or info (gnus-get-info group)))
  3299.     (uncompressed '(score bookmark killed))
  3300.     marked m)
  3301.     (or (not info)
  3302.     (and (not (setq marked (nthcdr 3 info)))
  3303.          (or (null articles)
  3304.          (setcdr (nthcdr 2 info)
  3305.              (list (list (cons type (gnus-compress-sequence
  3306.                          articles t)))))))
  3307.     (and (not (setq m (assq type (car marked))))
  3308.          (or (null articles)
  3309.          (setcar marked
  3310.              (cons (cons type (gnus-compress-sequence articles t) )
  3311.                    (car marked)))))
  3312.     (if force
  3313.         (if (null articles)
  3314.         (setcar (nthcdr 3 info)
  3315.             (delq (assq type (car marked)) (car marked)))
  3316.           (setcdr m (gnus-compress-sequence articles t)))
  3317.       (setcdr m (gnus-compress-sequence
  3318.              (sort (nconc (gnus-uncompress-range (cdr m))
  3319.                   (copy-sequence articles)) '<) t))))))
  3320.  
  3321. ;;;
  3322. ;;; Group timestamps
  3323. ;;;
  3324.  
  3325. (defun gnus-group-set-timestamp ()
  3326.   "Change the timestamp of the current group to the current time.
  3327. This function can be used in hooks like `gnus-select-group-hook'
  3328. or `gnus-group-catchup-group-hook'."
  3329.   (when gnus-newsgroup-name
  3330.     (let ((time (current-time)))
  3331.       (setcdr (cdr time) nil)
  3332.       (gnus-group-set-parameter gnus-newsgroup-name 'timestamp time))))
  3333.  
  3334. (defsubst gnus-group-timestamp (group)
  3335.   "Return the timestamp for GROUP."
  3336.   (gnus-group-get-parameter group 'timestamp))
  3337.  
  3338. (defun gnus-group-timestamp-delta (group)
  3339.   "Return the offset in seconds from the timestamp for GROUP to the current time, as a floating point number."
  3340.   (let* ((time (or (gnus-group-timestamp group)
  3341.           (list 0 0)))
  3342.          (delta (gnus-time-minus (current-time) time)))
  3343.     (+ (* (nth 0 delta) 65536.0)
  3344.        (nth 1 delta))))
  3345.  
  3346. (defun gnus-group-timestamp-string (group)
  3347.   "Return a string of the timestamp for GROUP."
  3348.   (let ((time (gnus-group-timestamp group)))
  3349.     (if (not time)
  3350.     ""
  3351.       (gnus-time-iso8601 time))))
  3352.  
  3353. (provide 'gnus-group)
  3354.  
  3355. ;;; gnus-group.el ends here
  3356.